Soru CSV uzantılı Dosya yı XLSX olarak farklı bir klasöre kaydetme Problemi Hk.

[Öz1.618]

Merhaba,
Elimde aşağıdaki kod var. Bu kod bana klasör yolunu soruyor ve içerisindeki csv uzantılı dosyaları başarılı bir şekilde xlsx uzantılı dosyaya dönüştürüyor. Fakat klasör içeirisnde hem csv hem xlsx uzantılı klasörler yer almış olduğu için bu karışıklıklık yaratıyor. Benim istediğim, csv den xlsx e dönüştürdükten sonra yolunu verdiğim klasör içerisinde bir alt klasör var ismi de "Qlik_xlsx" bu klasör içerisine kaydetmeyi sağlayabilir miyiz? yanlız bu klasör içersinde bir önceki haftadan kalmış olan bütün dosyaları da silmesini istiyorum. Teşekkür ederim.

Sub CSVtoXLS()
'UpdatebyExtendoffice20170814
Dim xFd As FileDialog
Dim xSPath As String
Dim xCSVFile As String
Dim xWsheet As String
Application.DisplayAlerts = False
Application.StatusBar = True
xWsheet = ActiveWorkbook.Name
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Title = "Select a folder:"
If xFd.Show = -1 Then
xSPath = xFd.SelectedItems(1)
Else
Exit Sub
End If
If Right(xSPath, 1) <> "\" Then xSPath = xSPath + "\"
xCSVFile = Dir(xSPath & "*.csv")
Do While xCSVFile <> ""
Application.StatusBar = "Converting: " & xCSVFile
Workbooks.Open Filename:=xSPath & xCSVFile
ActiveWorkbook.SaveAs Replace(xSPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
ActiveWorkbook.Close
Windows(xWsheet).Activate
xCSVFile = Dir
Loop
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub

 

[Öz1.618]

Merhaba,
Problemi çözdüm.
Kodu merak edenler için aşağıda paylaşıyorum.

Sub CSVtoXLS()
'UpdatebyExtendoffice20170814
Dim xSPath As String, NewPath As String
Dim xCSVFile As String
Dim wkbActv As Workbook, wkbCSV As Workbook

Set wkbActv = ActiveWorkbook
With Application
.DisplayAlerts = False
.StatusBar = True
.ScreenUpdating = False

With .FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder where the csv's are"
If .Show <> -1 Then Exit Sub
xSPath = .SelectedItems(1) & "\"

.Title = "Select the folder where you want the new xlsx"
If .Show <> -1 Then Exit Sub
NewPath = .SelectedItems(1) & "\"
End With
End With

xCSVFile = Dir(xSPath & "*.csv")
Do While xCSVFile <> ""
Application.StatusBar = "Converting: " & xCSVFile
Set wkbCSV = Workbooks.Open(Filename:=xSPath & xCSVFile)
wkbCSV.SaveAs Replace(NewPath & xCSVFile, ".csv", ".xlsx", vbTextCompare), xlWorkbookDefault
wkbCSV.Close
xCSVFile = Dir
Loop

wkbActv.Activate
Application.StatusBar = False
Application.DisplayAlerts = True
End Sub