Solved Converting txt file to xlsx (2 Viewers)

M

miacino

Registered User.
Local time
Today, 01:25
Joined
Jun 5, 2007
Messages
106
I'm trying to take all txt files in a folder and convert them to excel files. I 'borrowed' the below code and it seems to work EXCEPT that it only does text to columns on the header line. (Be gentle - I so appreciate all your expertise, but I'm really not great at this... Any help is appreciated!)
Code: 
Private Sub Command108_Click()
    Dim sDir As String
    Dim objXl As Object
    Dim objWB As Object
    Dim objSH As Object
    Const xlDelimited As Integer = 1
    Const xlDoubleQuote As Integer = 1
    Const xlOpenXMLWorkbook As Integer = 51
    
    sPath = "G:\CCCN\Payer Relations-Contracting\Payer Data Files\Anthem\test convert\"
    Set objXl = CreateObject("Excel.Application")
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    sDir = Dir$(sPath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Set objWB = objXl.Workbooks.Open(sPath & sDir)
        Set objSH = objWB.sheets(1)
        With objSH
            objXl.Selection.TextToColumns Destination:=.Range("A1"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
                :="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
        End With
        objWB.SaveAs FileName:=Left(objWB.FullName, InStrRev(objWB.FullName, ".")) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        objWB.Close False
        Set objSH = Nothing
        Set objWB = Nothing
        sDir = Dir$
    Loop
    objXl.Quit
    Set objXl = Nothing

End Sub
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 09:25
Joined
Sep 21, 2011
Messages
14,301
Why not record a macro in Excel that brings in a text file.
Then adapt that for your multiple files?
 
C

CJ_London

Super Moderator
Staff member
Local time
Today, 09:25
Joined
Feb 19, 2013
Messages
16,612
just did this macro to import a pipe delimited file.

Works OK for me - suggest compare with your code - I can see a number of differences in property names

Code: 
Sub Macro1()
'
' Macro1 Macro
'
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;D:\Dev\1_temp\test.txt", _
        Destination:=Range("$A$1"))
        .Name = "test"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


End Sub

Note this code does not include saving as .xlsx
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 16:25
Joined
May 7, 2009
Messages
19,243
you may also try this:
Code: 
Private Sub Command108_Click()
    Dim sDir As String
    Dim sPath As String
    
    sPath = "G:\CCCN\Payer Relations-Contracting\Payer Data Files\Anthem\test convert\"
    sDir = Dir$(sPath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Call fnConvertTextFileToExcel(sPath & sDir)
        sDir = Dir$
    Loop
End Sub

Sub fnConvertTextFileToExcel(ByVal TextFile As String)
    Const xlOpenXMLWorkbook As Integer = 51
    Dim fso                 As Object
    Dim inputFile           As Object
    Dim excelApp            As Object
    Dim excelWorkbook       As Object
    Dim excelWorksheet      As Object
    Dim lineText            As String
    Dim dataArray()         As String
    Dim rowIndex            As Long
    Dim colIndex            As Long

    ' Create FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Specify the path to your text file
    Set inputFile = fso.OpenTextFile(TextFile, 1)
    
    ' Create new instance of Excel application
    Set excelApp = CreateObject("Excel.Application")
    'excelApp.Visible = True
    
    ' Create new workbook
    Set excelWorkbook = excelApp.Workbooks.Add
    Set excelWorksheet = excelWorkbook.sheets(1)
    
    ' Read text file line by line and write to Excel
    rowIndex = 1
    Do While Not inputFile.AtEndOfStream
        lineText = inputFile.ReadLine
        dataArray = Split(lineText, ",") ' Assuming CSV format, change delimiter as needed
        
        ' Write data to Excel
        For colIndex = LBound(dataArray) To UBound(dataArray)
            excelWorksheet.Cells(rowIndex, colIndex + 1).Value = dataArray(colIndex)
        Next colIndex
        
        rowIndex = rowIndex + 1
    Loop
    
    ' Close and clean up
    inputFile.Close
    Set inputFile = Nothing
    Set fso = Nothing
    Set excelWorksheet = Nothing
    excelWorkbook.SaveAs _
                FileName:=fnGetPath(TextFile) & Replace$(fnGetFileName(TextFile), ".txt", ".xlsx"), _
                FileFormat:=xlOpenXMLWorkbook, _
                CreateBackup:=False
    excelWorkbook.Close
    Set excelWorkbook = Nothing
    excelApp.Quit
    Set excelApp = Nothing

End Sub

Public Function fnGetFileName(ByVal Path As String) As String
    Dim i As Integer
    fnGetFileName = Path
    i = InStrRev(Path, "\")
    If i <> 0 Then
        fnGetFileName = Mid$(Path, i + 1)
    End If
End Function


Public Function fnGetPath(ByVal FileName As String) As String
    Dim i As Integer
    fnGetPath = FileName
    i = InStrRev(FileName, "\")
    If i <> 0 Then
        fnGetPath = Left$(FileName, i)
    End If
End Function
 
E

ebs17

Well-known member
Local time
Today, 10:25
Joined
Feb 7, 2020
Messages
1,946
Before importing or converting, I would first look at the content of the text files themselves.
Any code to be applied must take into account the content that can be found, and if the content does not meet expected standards, standard processing methods will also fail.

So take a look at what you have before you start juggling codes.
 
M

miacino

Registered User.
Local time
Today, 01:25
Joined
Jun 5, 2007
Messages
106
arnelgp said:
you may also try this:
Code: 
Private Sub Command108_Click()
    Dim sDir As String
    Dim sPath As String
   
    sPath = "G:\CCCN\Payer Relations-Contracting\Payer Data Files\Anthem\test convert\"
    sDir = Dir$(sPath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Call fnConvertTextFileToExcel(sPath & sDir)
        sDir = Dir$
    Loop
End Sub

Sub fnConvertTextFileToExcel(ByVal TextFile As String)
    Const xlOpenXMLWorkbook As Integer = 51
    Dim fso                 As Object
    Dim inputFile           As Object
    Dim excelApp            As Object
    Dim excelWorkbook       As Object
    Dim excelWorksheet      As Object
    Dim lineText            As String
    Dim dataArray()         As String
    Dim rowIndex            As Long
    Dim colIndex            As Long

    ' Create FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")
   
    ' Specify the path to your text file
    Set inputFile = fso.OpenTextFile(TextFile, 1)
   
    ' Create new instance of Excel application
    Set excelApp = CreateObject("Excel.Application")
    'excelApp.Visible = True
   
    ' Create new workbook
    Set excelWorkbook = excelApp.Workbooks.Add
    Set excelWorksheet = excelWorkbook.sheets(1)
   
    ' Read text file line by line and write to Excel
    rowIndex = 1
    Do While Not inputFile.AtEndOfStream
        lineText = inputFile.ReadLine
        dataArray = Split(lineText, ",") ' Assuming CSV format, change delimiter as needed
       
        ' Write data to Excel
        For colIndex = LBound(dataArray) To UBound(dataArray)
            excelWorksheet.Cells(rowIndex, colIndex + 1).Value = dataArray(colIndex)
        Next colIndex
       
        rowIndex = rowIndex + 1
    Loop
   
    ' Close and clean up
    inputFile.Close
    Set inputFile = Nothing
    Set fso = Nothing
    Set excelWorksheet = Nothing
    excelWorkbook.SaveAs _
                FileName:=fnGetPath(TextFile) & Replace$(fnGetFileName(TextFile), ".txt", ".xlsx"), _
                FileFormat:=xlOpenXMLWorkbook, _
                CreateBackup:=False
    excelWorkbook.Close
    Set excelWorkbook = Nothing
    excelApp.Quit
    Set excelApp = Nothing

End Sub

Public Function fnGetFileName(ByVal Path As String) As String
    Dim i As Integer
    fnGetFileName = Path
    i = InStrRev(Path, "\")
    If i <> 0 Then
        fnGetFileName = Mid$(Path, i + 1)
    End If
End Function


Public Function fnGetPath(ByVal FileName As String) As String
    Dim i As Integer
    fnGetPath = FileName
    i = InStrRev(FileName, "\")
    If i <> 0 Then
        fnGetPath = Left$(FileName, i)
    End If
End Function
Click to expand...


Thank you , thank you arnelgp! That worked absolutely perfectly!
 
You must log in or register to reply here.

Similar threads

N
Solved Mass Importing Txt Files
Replies
14
Views
401
ebs17
E
W
CSV or XLSX Bank Statement to Access module (need to import via VBA and then write back to Excel with imported flag)
Replies
14
Views
1,058
Cotswold
Cotswold
J
accde doing crazy things
Replies
4
Views
686
John Sh
J
C
Solved i want to change this code to merge two excel files to one sheet side by side.
Replies
2
Views
219
camiramzi
C
T
Solved Append table to excel file
Replies
8
Views
813
ebs17
E

Users who are viewing this thread

Total: 2 (members: 0, guests: 2)
Top Bottom