PDA

View Full Version : [SOLVED] Need help with looping this code



vbid
07-04-2017, 07:01 PM
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\***x\Desktop\***\***.-2016.txt" _
, Destination:=Range("$A$1"))
.CommandType = 0
.Name = " ***.-2016_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 5, 17, 22, 16, 18, 17)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Thank you readers for helping me with this. Basically i have to loop this code to convert multiple text files into excel and save the file. I currently do not know how to loop this code but the files i want to convert all have ***.-2016.txt in its file name. I also do not know how to save these files automatically and convert the file name to something that i would require

mdmackillop
07-05-2017, 01:37 AM
This adds an incrementing number to the querytable name which you may not require.

Sub Test()
Dim sh As Worksheet
Dim pth As String, f As String, fPath As String, qName As String
Dim i As Long

pth = "C:\VBAX\" 'Change to suit
f = Dir(pth & "*.-2016.txt")
Do
i = i + 1
Set sh = Sheets.Add(after:=Sheets(Sheets.Count))
sh.Name = "Import" & Format(i, "00") 'Change to suit
fPath = pth & f
qName = Left(f, Len(f) - 4) & ".-2016_" & Format(i, "00") 'Change to suit
Call Imports(fPath, qName)
f = Dir
Loop Until f = ""
End Sub


Sub Imports(fPath, qName)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fPath, Destination:=Range("$A$1"))
.CommandType = 0
.Name = qName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(31, 5, 17, 22, 16, 18, 17)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

vbid
07-05-2017, 08:09 PM
Thank you for the code!

I was running the code and realized the import stops after certain number of files and not all the files were imported into the tabs. Could there be some problems with the code?

vbid
07-05-2017, 08:20 PM
The problem is solved. Thank you very much, I have spent weeks trying to figure this out