CODEWITHSUNDEEP
excelvba
He Li
He Li

Reputation: 25

Batch convert Excel to text-delimited files

Hi I'm facing a problem on dealing with converting Excel spreadsheets to txt files.

What I want to do is to create a Macro which can takes all the xls files in one folder and convert them to txt files.

The code currently working on 

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

But It's not working as expected, I have 0 knowledge on VB. Anyone willing to give a hand?

Upvotes: 1

Views: 18563

Answers (2)

Ansgar Wiechers
Ansgar Wiechers

Reputation: 200303

The issue with your code is that you define sPath as a path containing wildcard characters:

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

and replace only the extension portion (.xls*), but leave the wildcard character before the extension in place:

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

This produces the following path:

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

which causes the error you observed, because the SaveAs method tries to save the spreadsheet to a file with the literal name *.txt, but * is not a valid character for file names.

Replace this:

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

with this:

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

Upvotes: 0

user2299169
user2299169

Reputation:

The code below converts all Excel Workbooks (tests file extension for "xlsx") in a given folder into CSV files. File names will be [workbookname][sheetname].csv, ie "foo.xlsx" will get "foo.xlsxSheet1.scv", "foo.xlsxSheet2.scv", etc. In order to run it, create a plain text file, rename it to .vbs and copy-paste the code below. Change path info and run it.

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

You can give better file naming, error handling/etc if needed.

Upvotes: 4

Related Questions