How to save all Excel files in a folder as pipe delimited files

Question

I'm writing a process that needs to loop through all Excel files in a folder and save each one as a pipe delimited value.

I've done a lot of hunting on how to do this and most of them say to change the delimiter value in Region settings. This isn't an option for me as this will be implemented on a customer's system and I cannot change these settings.

I've got some code to work as a vba macro in each file, and I have a vbs script that loops through the files in a folder and converts them to tab delimited files, both of these were found from this site and adapted to do what I need.

This is the code i have so far:

WorkingDir = "C:\Test\Temp"
savedir="C:\Test\Temp\"

Dim fso, myFolder, fileColl, aFile, FileName, SaveName
Dim objExcel, objWorkbook
Dim lastColumn
Dim lastRow
Dim strString
Dim i
Dim j
Dim outputFile
Dim objectSheet
Dim objectCells


Set fso = CreateObject("Scripting.FilesystemObject")
Set myFolder = fso.GetFolder(WorkingDir)
Set fileColl = myFolder.Files

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
objExcel.DisplayAlerts = False

For Each aFile In fileColl
    name= Left(aFile.Name,Len(aFile.Name)-Len(Extension))
    Set objWorkbook = objExcel.Workbooks.Open(aFile)
    Set objectSheet = objExcel.ActiveWorkbook.Worksheets(1)
    Set objectCells = objectSheet.Cells
    lastColumn = objectSheet.UsedRange.Column - 1 + objectSheet.UsedRange.Columns.Count
    lastRow = objectSheet.UsedRange.Rows(objectSheet.UsedRange.Rows.Count).Row
    SaveName = savedir & name & ".txt"
    Set outputFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(SaveName, 2, true)
    For i = 1 To lastRow
        objectSheet.Cells(i, 1).Select '<-- this is the line currently causing problems
        strString = ""
        For j = 1 To lastColumn
            If j <> lastColumn Then
                strString = strString & objectCells(i, j).Value & "|"
            Else
                strString = strString & objectCells(i, j).Value
            End If
        Next
        outputFile.WriteLine(strString)
    Next

    objFileToWrite.Close
    Set objFileToWrite = Nothing
Next

Set objWorkbook = Nothing
Set objExcel = Nothing
Set myFolder = Nothing
Set fileColl = Nothing
Set fso = Nothing

I don't really use vb that often, so I'm basically changing a line until it stops throwing errors then moving on to the next one.

I just cannot get this over the commented line. It is currently giving me the error "Select method of Range class failed" with code 800A03EC. Searching this has given me no real results...

The file pretty much has to be pipe delimited as the file contains a lot of the common delimiters (commas, tabs etc.).

Any help to get this to work is greatly appreciated. This is my first post here so apologies if I've given too much or too little info, just let me know and I'll update as required

Update Have managed to get it working, my working code in answer below. If anyone has suggestions on how to make this faster it'd be appreciated :)

Answer 1

I managed to crack it, I had to activate the sheet I wanted before I could use it and also call the sheet by name instead of using "1". Working code is below in case it helps anyone else in the future. I know it's ugly and could probably be done better but it works :)

WorkingDir = "C:\Test\Temp"
savedir="C:\Test\Temp\"      
Extension = ".xls"

neededextension= ".txt"
Dim fso, myFolder, fileColl, aFile, FileName, SaveName
Dim objExcel, objWorkbook
Dim lastColumn
Dim lastRow
Dim strString
Dim i
Dim j
Dim outputFile
Dim objectSheet
Dim objectCells


Set fso = CreateObject("Scripting.FilesystemObject")
Set myFolder = fso.GetFolder(WorkingDir)
Set fileColl = myFolder.Files

Set objExcel = CreateObject("Excel.Application")
objExcel.EnableEvents = false

objExcel.Visible = False
objExcel.DisplayAlerts = False

For Each aFile In fileColl
    ext = Right(aFile.Name,Len(Extension))
    name= Left(aFile.Name,Len(aFile.Name)-Len(Extension))
    Set objWorkbook = objExcel.Workbooks.Open(aFile)
    Set objectSheet = objExcel.ActiveWorkbook.Worksheets("MICE BOB")
    Set objectCells = objectSheet.Cells
    lastColumn = objectSheet.UsedRange.Column - 1 + objectSheet.UsedRange.Columns.Count
    lastRow = objectSheet.UsedRange.Rows(objectSheet.UsedRange.Rows.Count).Row
    SaveName = savedir & name & ".txt"
    Set outputFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(SaveName, 2, true)
    For i = 1 To lastRow
        objectSheet.Activate
        objectSheet.Cells(i, 1).Select
        strString = ""
        For j = 1 To lastColumn
            If j <> lastColumn Then
                strString = strString & objectCells(i, j).Value & "|" ' Use ^ instead of pipe.
            Else
                strString = strString & objectCells(i, j).Value
            End If
        Next
        outputFile.WriteLine(strString)
    Next

    objFileToWrite.Close
    Set objFileToWrite = Nothing
Next

Set objWorkbook = Nothing
Set objExcel = Nothing
Set myFolder = Nothing
Set fileColl = Nothing
Set fso = Nothing

The only issue I have now is that the conversion takes a very long time. Does anyone have a suggestion on how to speed this up, or does the nature of this just mean it's going to be slow?