Fixing my record macro - Converting .txt format to Excel

Vgabond

Board Regular
Joined
Jul 22, 2008
Messages
197
Hi Gurus

I have recorded a macro and I need help to fix some of the code.

Code:
Sub ConvertExcel()'
' ConvertExcel Macro
'


'
    Workbooks.OpenText Filename:= _
        "D:\Work\2017\June2017.txt", Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
        Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
        41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
        Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
        54, 1)), TrailingMinusNumbers:=True
    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Work\Telesales\Calling List\Total_Contacted\2017\June2017.xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"
End Sub

Currently I have to change the file name ( D:\Work\2017\June2017.txt") in order for macro to pick the file and change it to Excel format. How can I run the macro and it will convert the entire file ?
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Try something like
Code:
Sub ConvertExcel()

Dim MyDate As Date
Dim MyMonth As String
Dim MyYear As String
Dim MyFileName As String


'Uses the end of the previous month as the variable MyDate:
MyDate = Application.WorksheetFunction.EoMonth(Date, -1)


'Gets the year and month name from the MyDate:
MyYear = Year(MyDate)   'MyYear will be used in the file path(s) as well
MyMonth = Application.WorksheetFunction.Proper(Format(MyDate, "mmmm"))


'Creates the FileName from the month name and the year
MyFileName = "\" & MyMonth & MyYear


    Workbooks.OpenText Filename:= _
        "D:\Work\" & MyYear & MyFileName & ".txt", Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
        Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
        41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
        Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
        54, 1)), TrailingMinusNumbers:=True
    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Work\Telesales\Calling List\Total_Contacted\" & MyYear & MyFileName & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"




End Sub

Modify the MyDate part to suit your needs if I did not guess it correctly.

Also the macro uses the year part of the MyDate variable in the file paths so in February 2018 it needs to find the "January2018.txt" in the "D:\Work\2018" -folder and the 2018 folder must be found in the "Total Contacted" -folder as well.
 
Upvote 0
Try something like
Code:
Sub ConvertExcel()

Dim MyDate As Date
Dim MyMonth As String
Dim MyYear As String
Dim MyFileName As String


'Uses the end of the previous month as the variable MyDate:
MyDate = Application.WorksheetFunction.EoMonth(Date, -1)


'Gets the year and month name from the MyDate:
MyYear = Year(MyDate)   'MyYear will be used in the file path(s) as well
MyMonth = Application.WorksheetFunction.Proper(Format(MyDate, "mmmm"))


'Creates the FileName from the month name and the year
MyFileName = "\" & MyMonth & MyYear


    Workbooks.OpenText Filename:= _
        "D:\Work\" & MyYear & MyFileName & ".txt", Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
        Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
        41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
        Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
        54, 1)), TrailingMinusNumbers:=True
    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"
    ActiveWorkbook.SaveAs Filename:= _
        "D:\Work\Telesales\Calling List\Total_Contacted\" & MyYear & MyFileName & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"




End Sub

Modify the MyDate part to suit your needs if I did not guess it correctly.

Also the macro uses the year part of the MyDate variable in the file paths so in February 2018 it needs to find the "January2018.txt" in the "D:\Work\2018" -folder and the 2018 folder must be found in the "Total Contacted" -folder as well.

Hi Miscaa

Is it possible of the code just read any file name in the folder and save it under the same file name after converted to excel? This to cater if I have a similar cases but not using the date format as a file name. Thanks a bunch
 
Upvote 0
If you want to loop though files in a folder you might want to try the Power Query instead of a macro? This way you could, for example, combine the data from all your txt files into a single Excel table and work it however you want to. Power Query has become my favorite Excel tool over the years. When it was first introduced in 2010 (?) it was a free addin but they included it in the application itself in Excel 2016 (="Get & Transform" found on the Data ribbon).

It's not that hard to make the macro loop the files in the folder either but it'll take a bit more time so I'll try to get back to it later on but I really suggest you consider taking the Power Query route rather than stick with the VBA solution. It's more likely not only easier but faster too.

Here's a short Power Query video which shows the basic steps to what I see would be ideal to your needs:
Excel Power Query #04: Import Multiple CSV Files In 1 Step & Retrieve New Files Automatically - YouTube

You might need to change a step or two slightly but most likely you can do the changes with the buttons found in the Transform tab of the Power Query -tool.
 
Upvote 0
Try this:
Code:
Function GetFolder(MyText As String) As String    Dim Fldr As FileDialog
    Dim sItem As String
    Set Fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With Fldr
        .Title = MyText
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set Fldr = Nothing
End Function










Sub ConvertExcel(MySourcePath As String, MyDestinationPath As String, MyFileName As String)


    If Right(MySourcePath, 1) <> "\" Then MySourcePath = MySourcePath & "\"
    If Right(MyDestinationPath, 1) <> "\" Then MyDestinationPath = MyDestinationPath & "\"


    Workbooks.OpenText Filename:= _
        MySourcePath & MyFileName & ".txt", Origin:= _
        437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _
        ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array( _
        28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
        Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array( _
        41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
        Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array( _
        54, 1)), TrailingMinusNumbers:=True
'    Application.Goto Reference:="Convert_To_Excel!ConvertExcel"
    ActiveWorkbook.SaveAs Filename:= _
        MyDestinationPath & MyFileName & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
  '  Application.Goto Reference:="Convert_To_Excel!ConvertExcel"


'Closes the created workbook:
ActiveWorkbook.Close False




End Sub




Sub LoopThroughTxTFiles()
Dim strFileName As String
Dim intNumberOfFiles As Integer
Dim MySourcePath As String
Dim MyDestinationPath As String
Dim MyFileName As String


MySourcePath = GetFolder("Select the origin folder.")
MyDestinationPath = GetFolder("Select the destination folder.")


Application.ScreenUpdating = False


intNumberOfFiles = 0


strFileName = Dir(MySourcePath & "\*.txt", vbNormal)


Do Until strFileName = ""
    intNumberOfFiles = intNumberOfFiles + 1
    
    MyFileName = Left(strFileName, Len(strFileName) - 4)
    
    Call ConvertExcel(MySourcePath, MyDestinationPath, MyFileName)
    
    strFileName = Dir()
Loop


MsgBox intNumberOfFiles & " txt-files saved!", vbOKOnly, "Done!"


End Sub

This should work but I can't really test it without proper sample files.

Run only the LoopThroughTxTFiles -macro. The first piece of code is just a function asking for the folder names and the next one is your original macro which I had to change a little bit to use the new folders and file names.
 
Last edited:
Upvote 0
If you want to loop though files in a folder you might want to try the Power Query instead of a macro? This way you could, for example, combine the data from all your txt files into a single Excel table and work it however you want to. Power Query has become my favorite Excel tool over the years. When it was first introduced in 2010 (?) it was a free addin but they included it in the application itself in Excel 2016 (="Get & Transform" found on the Data ribbon).

It's not that hard to make the macro loop the files in the folder either but it'll take a bit more time so I'll try to get back to it later on but I really suggest you consider taking the Power Query route rather than stick with the VBA solution. It's more likely not only easier but faster too.

Here's a short Power Query video which shows the basic steps to what I see would be ideal to your needs:
Excel Power Query [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=04]#04 : Import Multiple CSV Files In 1 Step & Retrieve New Files Automatically - YouTube[/URL]

You might need to change a step or two slightly but most likely you can do the changes with the buttons found in the Transform tab of the Power Query -tool.

Sure thing. I'll watch it..
 
Upvote 0

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top