Для этого действительно нет необходимости использовать powershell, вам просто нужно использовать правильные методы в VBA ...
Код не проверен, но думаю, что он должен работать нормально ...
Sub ConvertToCSV()
Application.ScreenUpdating = False
Dim StrFile As String
StrFile = Dir("C:\Users\example\*PLZ*")
Do While Len(StrFile) > 0
'Open workbook
Dim wb as workbook
set wb = Workbooks.Open("C:\Users\example\" & StrFile)
'Save workbook to new location
Dim DestFile As String
DestFile = "C:\Users\example\" & Left(StrFile, Len(StrFile) - 5)
wb.saveAs destFile, xlFileFormat.xlCSV
'Ensure no alerts while close
Application.displayAlerts = false
wb.close false
Application.displayAlerts = true
'Continue loop
StrFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
Редактировать:
Извинения Я не видел требования к заключению строк в кавычки. Можно сделать несколько исправлений для вашего кода, которые сделают его работу значительно быстрее, ключ состоит в том, чтобы сначала преобразовать файл в массив:
Я пытался сохранить ваш код как можно ближе к нему. Обратите внимание, что вы в настоящее время разделяете файлы точкой с запятой ...
Sub ConvertToCSV()
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Long
Dim StrFile As String
Application.ScreenUpdating = False
StrFile = Dir("C:\Users\example\*PLZ*")
Do While Len(StrFile) > 0
'Open workbook and store in variable
Dim wb as workbook
set wb = Workbooks.Open("C:\Users\example\" & StrFile)
'Get data as array
Dim r as range, v as variant
set r = wb.ActiveSheet.Range("A1").CurrentRegion
v = r.value2
'Get dest path
NameWithoutExtension = Left(StrFile, Len(StrFile) - 5)
DestFile = "C:\Users\example\" & NameWithoutExtension
FileNum = FreeFile()
'Try open file
On Error Resume Next
Open DestFile For Output As #FileNum
'If error then end
If Err <> 0 Then
MsgBox "Cannot open filename " & DestFile
End
End If
On Error GoTo 0
'Loop over array
Dim i as long, j as long
For i = 1 To ubound(v,1)
For j = 1 To ubound(v,2)
OldText = v(i,j)
MiddleText = Replace(OldText, "\", "/")
NewText = Replace(MiddleText, """", "\""")
' Write current cell's text to file with quotation marks.
Print #FileNum, """" & NewText & """";
' Check if cell is in last column.
If j = ubound(v,2) Then
' If so, then write a blank line.
Print #FileNum,
Else
' Otherwise, write a comma.
Print #FileNum, ";";
End If
Next j 'Next column
Next i 'Next row
' Close destination file.
Close #FileNum
'Close workbook
wb.Close false
'Get next file path
StrFile = Dir
Loop
MsgBox ("Done")
End Sub
Примечание. Если ваш набор данных огромен, это может вызвать ошибку нехватки памяти. Если это так, go с powershell.
Import-Excel .\Book1.xlsx | Export-Csv .\book1.csv