VBA'da otomatik olarak 'Sütunlara metin' ve 'farklı kaydet' nasıl yapılır?

Question

.csv dosyalarının (B1 hücresi) bulunduğu bir kaynak dizinim var. Ve aynı dosyaları .xlsx (B2 hücresi) olarak kaydettiğim, Metin Kolları gibi bazı işlemleri gerçekleştiren, aşağıda gösterilen VBA makrosu ile sınırlayıcıları seçen bir hedef dizin. Her defasında makro geldiğinde gerçeği dışında oldukça iyi çalışıyor

Sub FileList() 

Dim directory As String, fileName As String, saveas As String, fileNameXlsx As String 
Dim file As Variant 
Dim wb As Workbook, LastRow As Long, LastRow1 As Long 
Dim i As Integer, j As Integer 
Set wb = Workbooks("CSV_File.xlsm") 
Application.ScreenUpdating = False 

'Clear old data 
LastRow = Sheets("FileList").Range("A" & Sheets("FileList").Rows.Count).End(xlUp).Row 
Sheets("FileList").Select 
Range("A1:A" & LastRow).Select 
Selection.ClearContents 

directory = wb.Sheets("Directory").Cells(1, 2).Value 
saveas = wb.Sheets("Directory").Cells(2, 2).Value 
file = Dir(directory & "*.csv") 

While (file <> "") 
i = i + 1 
j = 1 
wb.Sheets("FileList").Cells(i, j).Value = file 
file = Dir 
Wend 

LastRow1 = Sheets("FileList").Range("A" & Sheets("FileList").Rows.Count).End(xlUp).Row 
For i = 1 To LastRow1 
On Error Resume Next 
'.csv FileName 
Range("B" & i).Select 
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],(LEN(RC[-1])-4))" 
fileNameXlsx = wb.Sheets("FileList").Cells(i, 2).Value & ".xlsx" 
fileName = wb.Sheets("FileList").Cells(i, 1).Value 
'Open .xlsx file 
Workbooks.Open (directory & fileName) 
Columns("A:A").Select 
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _ 
     Comma:=True, FieldInfo _ 
     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 
     Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), DecimalSeparator:= _ 
     ",", ThousandsSeparator:=" ", TrailingMinusNumbers:=True 
    ChDir saveas 
    ActiveWorkbook.saveas fileNameXlsx _ 
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 
'Close .xlsx 
Workbooks(fileNameXlsx).Close SaveChanges:=False 
Next i 

End Sub 

:

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _ 
     Comma:=True, FieldInfo _ 
     :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ 
     Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), DecimalSeparator:= _ 
     ",", ThousandsSeparator:=" ", TrailingMinusNumbers:=True 
    ChDir saveas 

Bana bir aşağıdaki mesajı gösterir ve ben “Tamam” butonu tıklanarak onaylamanız gerekir.

Bunu atlamanın herhangi bir yolu varsa (otomatik olarak "OK" ye tıklamak) olup olmadığını sormak isterim? Teşekkürler.

Answer 1

Sen makro üstündeki

Applications.DisplayAlerts = False 

ekleyebilirsiniz, böylece hiçbir uyarı gösterilir (hiç!). Kodun sonunda bunu true olarak geri almayı unutmayın.