VBA Kopyalama Problemi

[sadoo123]

fso.copyfile copybanner & Country & " Branda.pdf", mainklasor & "\" & "Banner" & "\"

Merhaba. Office 365 sürümü kullanıyorum. Yukarıdaki kodla bazı dosyaları farklı klasöre kopyalıyorum. "Country" bir değişken. Bu değişken mesela Lübnan gibi türkçe karakter içeren bir ülke olduğunda kod kopyalama yapmıyor. Statik olarak

fso.copyfile copybanner & "Lübnan Branda.pdf", mainklasor & "\" & "Banner" & "\"

bu şekilde de denedim. Kopyalamıyor. Türkçe karakter içermeyen bir ülke olursa mesela Pakistan. Bu halde kopyalıyor.

Bu kod tüm kodun sadece bir parçası. Koddaki dinamiklere göre kopyalama yapmam gerekiyor. Dosya isimlerini değiştiremem.Bu haliyle bir çözümü varmıdır?

 

[muhasebeciyiz]

Option Explicit

Sub DosyaKopyala()
Dim country As String
Dim sourcePath As String, destPath As String
country = "Lübnan"
sourcePath = "C:\User\Kaynak\Klasör" & "\Banner\" & "copybanner " & country & " Branda.pdf"

If Dir(destPath, vbDirectory) = "" Then
MkDir destPath
End If

destPath = sourcePath
On Error Resume Next
FileCopy sourcePath, destPath
If Err.Number <> 0 Then
MsgBox "Dosya kopyalarken hata oluştu: " & Err.Description, vbCritical
End If
On Error GoTo 0

End Sub

Muhtemelen Türkçe karakterlerle ilgili bir kodlama sorunu yaşıyorsunuz. Belirli karakterlerin işlenmesiyle ilgili bir problem olabilir.

 

[sadoo123]

Option Explicit

Sub DosyaKopyala()
Dim country As String
Dim sourcePath As String, destPath As String
country = "Lübnan"
sourcePath = "C:\User\Kaynak\Klasör" & "\Banner\" & "copybanner " & country & " Branda.pdf"

If Dir(destPath, vbDirectory) = "" Then
MkDir destPath
End If

destPath = sourcePath
On Error Resume Next
FileCopy sourcePath, destPath
If Err.Number <> 0 Then
MsgBox "Dosya kopyalarken hata oluştu: " & Err.Description, vbCritical
End If
On Error GoTo 0

End Sub

Muhtemelen Türkçe karakterlerle ilgili bir kodlama sorunu yaşıyorsunuz. Belirli karakterlerin işlenmesiyle ilgili bir problem olabilir.

Hocam Country bir Variant bende. String değil. For döngüsü ile satıra göre sürekli değişiyor. Evet Country değişkeni türkçe karakter içeren bir ülkeye eşit olduğu zaman linkteki dosyayı kopyalamıyor.

Yukarıdaki kodlamanızı test ettim. Klasör yolundan bağımsız hata veriyor. Aslında klasör yolunda da türkçe karakter var "Masaüstü" gibi... Ama dosya isminin olduğu kısımda problem çıkarıyor. File not found diyor. Mesela country Pakistan yaparsam kopyalıyor. Lübnan yaparsam yine hata veriyor sizin kodda da.

 

[muhasebeciyiz]

Yöntem :1

Sub DosyaKopyala()
Dim Country As Variant
Dim mainklasor As String
Dim dosyaAdi As String

mainklasor = "Ana Klasör Yolu"

For Each Country In Array("Pakistan", "Lübnan", "Türkiye")

Select Case Country
Case "Pakistan"
dosyaAdi = "copybanner Pakistan Branda.pdf"
Case "Lübnan"
dosyaAdi = "copybanner L" & ChrW$(252) & "bnan Branda.pdf"
Case "Türkiye"
dosyaAdi = "copybanner Türkiye Branda.pdf"
End Select

FileCopy mainklasor & "\Banner\" & dosyaAdi, mainklasor & "\Banner\"
Next Country
End Sub

Ana klasör yolunu belirtiniz ve örnek ülkleri diziye ekleyip deneyiniz

Yöntem :2

Sub MovePDFs()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
FromPath =
ToPath =

For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
If Right(FileInFromFolder.Name, 3) = "pdf" Then
FileInFromFolder.Move ToPath
End If
Next FileInFromFolder

Set FSO = Nothing
End Sub

Not: Path yollarını yazmayı unutmayınız

 

[alicimri]

Dosya ismi kullanmadan sadece kopyalanacak klasör isimleri kullanılarak aşağıdaki kodu kırmızı yazılı yerleri kendinize uyarlayarak deneyin.

Sub FSOMoveAllFiles()
Dim FSO As New FileSystemObject
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object
i = 1
FromPath =xxxxxxxxxxxxxxx
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
ToPath = Range("A" & i)
If Right(FileInFromFolder.Name, 3) = "pdf" Then
FileInFromFolder.Move ToPath
i = i + 1
End If
Next FileInFromFolder
End Sub
Not. Referans olarak Microsoft Scripting Runtime işaretleyin

 

[sadoo123]

Yöntem :1

Sub DosyaKopyala()
Dim Country As Variant
Dim mainklasor As String
Dim dosyaAdi As String

mainklasor = "Ana Klasör Yolu"

For Each Country In Array("Pakistan", "Lübnan", "Türkiye")

Select Case Country
Case "Pakistan"
dosyaAdi = "copybanner Pakistan Branda.pdf"
Case "Lübnan"
dosyaAdi = "copybanner L" & ChrW$(252) & "bnan Branda.pdf"
Case "Türkiye"
dosyaAdi = "copybanner Türkiye Branda.pdf"
End Select

FileCopy mainklasor & "\Banner\" & dosyaAdi, mainklasor & "\Banner\"
Next Country
End Sub

Ana klasör yolunu belirtiniz ve örnek ülkleri diziye ekleyip deneyiniz

Yöntem :2

Sub MovePDFs()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
FromPath =
ToPath =

For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
If Right(FileInFromFolder.Name, 3) = "pdf" Then
FileInFromFolder.Move ToPath
End If
Next FileInFromFolder

Set FSO = Nothing
End Sub

Not: Path yollarını yazmayı unutmayınız

Çok teşekkürler hocam. Emeğinize sağlık. Kopyasını almam gerektiğinden 2. yönteminizi kullanamıyorum. Dosyaları toplu kopyalamıyorum zaten. Aslında kurguladığım kodda kod ilk önce dinamik bir yeni klasör oluşturuyor sonra ülkeye göre dosyaları seçip o klasöre atıyor.

1. Yönteminizi daha önce de gördüm. Daha önce de denemiştim ama yine denedim. Yine dosyayı bulamıyor. Dosya yolunu kopyalayıp direkt VBA ya yapıştırınca da ü harfini bir acayip gösteriyor. satir 1 stringine bakınız bunun için. Sistemde herşey türkçe seçili, font courrier new türkçe. Office 365 teki bir sıkıntı mı acaba

(Aşağıdaki kurguda dosya ismi üad branda olmuş ama takılmayın göstermek için attım. Lübnan Branda olacak şekilde düzgün yaptığımda da dosyayı bulamadı.)

 

[sadoo123]

Dosya ismi kullanmadan sadece kopyalanacak klasör isimleri kullanılarak aşağıdaki kodu kırmızı yazılı yerleri kendinize uyarlayarak deneyin.

Sub FSOMoveAllFiles()
Dim FSO As New FileSystemObject
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object
i = 1
FromPath =xxxxxxxxxxxxxxx
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each FileInFromFolder In FSO.GetFolder(FromPath).Files
ToPath = Range("A" & i)
If Right(FileInFromFolder.Name, 3) = "pdf" Then
FileInFromFolder.Move ToPath
i = i + 1
End If
Next FileInFromFolder
End Sub
Not. Referans olarak Microsoft Scripting Runtime işaretleyin

Cevabınız için teşekkürler. Ama dosyayı seçip kopyalamam gerekiyor. Klasörü komple kopyalayamıyorum. İlgili ülkenin klasörüne sadece ilgili ülkenin dosyasını kopyalıyorum.

 

[sadoo123]

İlginç bir şekilde düzeldi. Türkçe karakter içeren dosyaların isimlerini değiştirdim daha sonra eski ismini girdim. Şuan Dosya bulunamadı hatası almıyorum. Bu konudan muzdarip çok kişi var görenler için belki yardımcı olur diye yazayım dedim. Burdan çıkardığım birkaç netice:

- Office'i onarın. Detaylı bilgi internette var.

- Eğer kodlamada klasör ve dosya işlemleri yapacaksanız işlem yapacağınız klasörün dosyalarını içine atmadan kodlamayı yani excel dosyanızı oluşturun. Daha sonra dosyaları klasörünüze atın.

- Dosya bulunamadı hatası veriyorsa mümkünse klasördeki dosyaların ismini değiştirin. (ki bunun için toplu dosya ismi değiştirme makroları vs var) Daha sonra tekrar değiştirerek eski isimlerini verin.

- Bu işlemler sizde doğru çalışırsa unicode karakter vs kullanmanıza gerek kalmayacaktır. VBA da direkt olarak türkçe karakter kullanıp dosya yolu oluşturabilirsiniz.