Dosya adında Türkçe karakter sorgulamak

[k0081]

Merhaba arkadaşlar;


C:\deneme klasörü altındaki dosyaların isimlerinde; Ç,Ş,Ü,Ğ,Ö,İ, ç,ş,ü,ğ,ö,ı bu harflerden biri varsa Msgbox ile mesaj versin.( Türkçe karakter harfler VAR.) yoksa da mesaj versin.. ( Türkçe karakter harfler YOK.)

* Aynı sorgulama Aktif KLASÖR için de yapılması gerekiyor. (Bu örnek deki klasör adı: Deneme )

Bu iki sorgulamayı Command buton kullanarak nasıl yapabilirim ?

yardımcı arkadaşa şimdiden teşekkürler..

 

[hamitcan]

File System Object ile dosya isimlerini aldırıp kontrol yapabilirsiniz.

 

[veyselemre]

Sub turkceKarakterKontrol()
    Dim fso, FileName, MyFile

    FileName = "d:\dir1.txt"
    If Dir(FileName) <> "" Then Kill FileName
    Shell ("cmd /c dir c:\deneme /s/b >" & FileName)

    If Dir(FileName) = "" Then Application.Wait (Now + TimeValue("0:00:01"))

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set MyFile = fso.OpenTextFile(FileName, 1)

    If MyFile.AtEndOfStream Then
        ReadAllTextFile = ""
    Else
        ReadAllTextFile = MyFile.ReadAll
    End If

    tKar = Array(128, 135, 159, 158, 148, 153, 141, 152, 167, 166)

    For Each kar In tKar
        If InStr(ReadAllTextFile, Chr(kar)) > 0 Then
            MsgBox "Türkçe Karekter Var.." & kar
            Exit Sub
        End If
    Next kar
    MsgBox "Türkçe Karekter Yok.."
    Set fso = Nothing
    Set MyFile = Nothing
End Sub

 

[muygun]

Merhaba;
Alternatif olsun.

Sub klasördeki_dosyalarda_türkçe_karakter_kontrolü()
Application.ScreenUpdating = False
On Error Resume Next
c = 1
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(ThisWorkbook.Path)
Set dc = f.Files
For Each dosya In dc
c = c + 1
dosyaa = Mid(dosya.Name, 1, Len(dosya.Name) - 4)
If InStr(1, dosyaa, "Ç") >= 1 Then t1 = "Ç"
If InStr(1, dosyaa, "ç") >= 1 Then t2 = "ç"
If InStr(1, dosyaa, "Ş") >= 1 Then t3 = "Ş"
If InStr(1, dosyaa, "ş") >= 1 Then t4 = "ş"
If InStr(1, dosyaa, "Ü") >= 1 Then t5 = "Ü"
If InStr(1, dosyaa, "ü") >= 1 Then t6 = "ü"
If InStr(1, dosyaa, "Ğ") >= 1 Then t7 = "Ğ"
If InStr(1, dosyaa, "ğ") >= 1 Then t8 = "ğ"
If InStr(1, dosyaa, "Ö") >= 1 Then t9 = "Ö"
If InStr(1, dosyaa, "ö") >= 1 Then t10 = "ö"
If InStr(1, dosyaa, "İ") >= 1 Then t9 = "İ"
If InStr(1, dosyaa, "ı") >= 1 Then t10 = "ı"
sorg = t1 & t2 & t3 & t4 & t5 & t6 & t7 & t8 & t9 & t10
If sorg <> "" Then say = say + 1
Next
If say >= 1 Then MsgBox (say & " adet dosya isminde Türkçe karakter var")
If say = 0 Then MsgBox (" Dosya isimlerinde Türkçe karakter YOK")
End Sub

İyi çalışmalar.

 

[k0081]

Arkadaşlar öncelikle geç dönüş yaptığım için özür...

Sn. Hamitcan

Teşekkürler hocam.


Sn.muygun

Hocam çok teşekkür ediyorum,, Tamamdır.. elinize sağlık..

Sn. Veysel emre

Kodlarınızı denedim. Sanırım dosyanın içeriğine bakarak sonuç veriyor.. Dosya içeriği değilde sadece dosya adında sorgulama yapması gerekiyor.. Ama göndermiş olduğunuz bu kodda da farklı bölümler gördüm. ve öğrenmiş oldum. Çok teşekkür ediyorum..