CSV Uzantılı dosyaları Excelle çevirme

[halit3]

CSV Uzantılı dosyaları Excelle çevirme ile ilgili çalışma

kod:

Dim msg1

Sub csvye_cevir()

Sayfa_Adı = ActiveSheet.Name
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Lütfen bir klasör seçiniz", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 msg1 = MsgBox("Csv Dosyalarını" & Chr(10) & Chr(10) & _
 "silmek için  EVET tıklayınız. " & Chr(10) & Chr(10) & _
"silmemek için HAYIR tıklayınız.", vbYesNo + vbInformation, "u y a r ı !")

Liste3 (Klasor.Items.Item.Path)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Klasor = Nothing

End Sub


Private Sub Liste3(yol As String)
Dim fs As Object, f As Object
Set fs = CreateObject("Scripting.FileSystemObject")

uzanti = fs.GetExtensionName(ThisWorkbook.Name)

Dim wb As Workbook

For Each dosya In fs.GetFolder(yol).Files
If ThisWorkbook.Name <> dosya.Name Then
If LCase(fs.GetExtensionName(dosya)) = "csv" Then

ad = yol & "\" & "Excel Dosyaları"

If CreateObject("Scripting.FileSystemObject").FolderExists(ad) = False Then
MkDir ad
End If

If uzanti = "xls" Then
FileFormatNum = -4143
uzanti2 = "xls"
ElseIf uzanti = "xlsm" Then
FileFormatNum = 51
uzanti2 = "xlsx"
ElseIf uzanti = "xlsx" Then
FileFormatNum = 51
uzanti2 = "xlsx"
End If

Set wb = Workbooks.OpenXML(dosya)
Application.DisplayAlerts = False
wb.SaveAs ad & "\" & fs.GetBaseName(dosya) & "." & uzanti2, FileFormat:=FileFormatNum '6   '-4158 'xlText
wb.Close False
If msg1 = vbYes Then
fs.DeleteFile dosya
End If

End If
End If
Next

On Error GoTo sonraki
For Each f In fs.GetFolder(yol).subfolders
Liste3 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

 

[assenucler]

Sayın halit3,


Gününüz aydınlık, neşeniz ve sağlığınız yerinde ve kazancınız bol olsun üstadım.

Paylaşımlarınız için teşekkürler.

Sevgi ve saygılar.

 

[halit3]

Sayın halit3,


Gününüz aydınlık, neşeniz ve sağlığınız yerinde ve kazancınız bol olsun üstadım.

Paylaşımlarınız için teşekkürler.

Sevgi ve saygılar.

Teşekkürler iyi çalışmalar

 

[isaser]

Teşekürler.
.
.