Пакетное преобразование Excel в файлы с разделителями текста

Question

Привет, У меня возникла проблема с преобразованием таблиц Excel в txt-файлы.

Что я хочу сделать, так это создать макрос, который может принимать все файлы xls в одной папке и преобразовывать их в файлы txt.

Код в настоящее время работает на

Sub Combined() 

    Application.DisplayAlerts = False 

    Const fPath As String = "C:\Users\A9993846\Desktop\" 
    Dim sh As Worksheet 
    Dim sName As String 
    Dim inputString As String 

    With Application 
    .Calculation = xlCalculationManual 
    .EnableEvents = False 
    .ScreenUpdating = False 
    End With 

    sName = Dir(fPath & "*.xls*") 

    Do Until sName = "" 
    With GetObject(fPath & sName) 
     For Each sh In .Worksheets 
     With sh 
      .SaveAs Replace(sName, ".xls*", ".txt"), 42 'UPDATE: 
     End With 
     Next sh 
     .Close True 
    End With 
    sName = Dir 
    Loop 

    With Application 
    .Calculation = xlAutomatic 
    .EnableEvents = True 
    .ScreenUpdating = True 
    End With 
End Sub 

Но это не работает, как и ожидалось, у меня 0 знания на VB. Любой, кто хочет дать руку?

Answer 1

Приведенный ниже код преобразует все книги Excel (тестовое расширение файла для «xlsx») в заданную папку в файлы CSV. Имена файлов будут [workbookname] [имя листа] .csv, то есть «foo.xlsx» получит «foo.xlsxSheet1.scv», «foo.xlsxSheet2.scv» и т. Д. Чтобы запустить его, создайте простой текстовый файл , переименуйте его в .vbs и скопируйте-вставьте код ниже. Измените информацию о пути и запустите ее.

Option Explicit 

Dim oFSO, myFolder 
Dim xlCSV 

myFolder="C:\your\path\to\excelfiles\" 


Set oFSO = CreateObject("Scripting.FileSystemObject") 
xlCSV = 6 'Excel CSV format enum 
Call ConvertAllExcelFiles(myFolder) 
Set oFSO = Nothing 

Call MsgBox ("Done!") 


Sub ConvertAllExcelFiles(ByVal oFolder) 
Dim targetF, oFileList, oFile 
Dim oExcel, oWB, oWSH 

    Set oExcel = CreateObject("Excel.Application") 
    oExcel.DisplayAlerts = False 
    Set targetF = oFSO.GetFolder(oFolder) 
    Set oFileList = targetF.Files 
    For Each oFile in oFileList 
     If (Right(oFile.Name, 4) = "xlsx") Then 
      Set oWB = oExcel.Workbooks.Open(oFile.Path) 
      For Each oWSH in oWB.Sheets 
       Call oWSH.SaveAs (oFile.Path & oWSH.Name & ".csv", xlCSV) 
      Next 
      Set oWSH = Nothing 
      Call oWB.Close 
      Set oWB = Nothing 
     End If 
    Next 
    Call oExcel.Quit 
    Set oExcel = Nothing 

End Sub 

Вы можете дать лучшее имя файла, обработку ошибок/etc, если необходимо.

Answer 2

Проблема с кодом является то, что вы определяете sPath как путь, содержащие подстановочные символы:

sName = Dir(fPath & "*.xls*") 

и заменить только часть расширения (.xls*), но оставить символ подстановки перед расширением на месте:

Replace(sName, ".xls*", ".txt") 

Это приводит следующий путь:

C:\Users\A9993846\Desktop\*.txt 

, который вызывает обнаруженную ошибку, поскольку метод SaveAs пытается сохранить таблицу в файле с буквальным именем *.txt, но * не является допустимым символом для имен файлов.

Заменить это:

.SaveAs Replace(sName, ".xls*", ".txt"), 42 

с этим:

Set wb = sh.Parent 
basename = Replace(wb.FullName, Mid(wb.Name, InStrRev(wb.Name, ".")), "") 
.SaveAs basename & "_" & sh.Name & ".txt", xlUnicodeText