Excel VBA Text File Import Is Blank - excel

I am trying to import 800+ text files into their own worksheets within the same workbook. Code for that is below:
Public Sub dImport()
nFile = Dir("R:\O21DIR\*.txt")
Do While nFile <> vbNullString
Set ws3 = Sheets.Add(After:=Sheets(Sheets.Count))
Application.CutCopyMode = False
With ws3.QueryTables.Add(Connection:="TEXT;" & nFile, Destination:=Range("$A$1"))
.Name = nFile
.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(2, 2, 2, 2, 2, 9, 9, 2, 9, 2, 9, 9, 9)
.TextFileFixedColumnWidths = Array(21, 16, 10, 13, 17, 3, 14, 7, 5, 12, 5, 6)
.TextFileTrailingMinusNumbers = True
End With
ws3.Name = nFile
For cnt = ActiveWorkbook.Connections.Count To 1 Step -1
ActiveWorkbook.Connections.Item(cnt).Delete
Next
For cnt = ActiveWorkbook.Queries.Count To 1 Step -1
ActiveWorkbook.Queries.Item(cnt).Delete
Next
nFile = Dir
fRefine
Loop
End Sub
I get no errors, but I also get NOTHING on the sheet. The worksheet is created and named correctly. And the text file DOES have data in it. The data import code was pulled from recording a macro, so it DID work at one point.
I did delete the .Refresh BackgroundQuery:=False because I was getting an Error 1004.
What am I missing/doing wrong?
Using Excel 2016 on Office 365 32-bit. I've tried this on 2 different systems with the same software setup. Same results.

I am not a subject matter expert, but by looking at the documentation, I think you should add a Refresh somewhere.
Pasted from above page:
Set shFirstQtr = Workbooks(1).Worksheets(1)
Set qtQtrResults = shFirstQtr.QueryTables.Add( _
Connection := "TEXT;C:\My Documents\19980331.txt", _
Destination := shFirstQtr.Cells(1,1))
With qtQtrResults
.TextFileParsingType = xlFixedWidth
.TextFileFixedColumnWidths := Array(5,4)
.TextFileColumnDataTypes := _
Array(xlTextFormat, xlSkipColumn, xlGeneralFormat)
.Refresh
End With

Related

VBA macro run time error '5' on excel in a Sub

I have a slight issue with my VBA macro I get a run time error on this part and I can't figure out where it is, basically the code is meant to open a File Explorer and the user chooses a CSV and then the VBA copies the sheet in a new sheet inside the workbook that has the Macro in it.
Sub manipulate_csv()
Sheets.Add After:=ActiveSheet
csvDatasheetName = "CSV Feed Data"
massagedDatasheetName = "Massaged Data"
objFile = Application.GetOpenFilename(fileFilter:="All Files(* . *) , * . * ") ' choose load path'
connectionText = "TEXT;" & objFile
With ActiveSheet.QueryTables.Add(Connection:= _
connectionText, Destination:= _
Range("$A$1"))
.Name = "TestCSV"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileCommaDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End with
End sub
If you have any idea what is causing my issue, I would be very thankful, to help me solve it.
Best regards

subroutine not working when run as a sheet macro

I have a process that created a .xlsm file with a sheet macro, ie a macro that is internal to the sheet and not run in a separate module.
Inside one of the sheet subroutines, I am trying to import a .csv file using this method:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & INFILE, Destination:=Range("$A$1"))
.Name = "NLIST"
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileTabDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(8, 36, 2, 4, 7, 4, 4)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
The issue is that is doesn't work as a sheet macro.
It only works when it's inside it's own module.
I have tried changing all the "." references to this sort of structure:
With sheets("NLIST").QueryTables.Add(Connection:= _
"TEXT;" & INFILE, Destination:=Range("$A$1"))
sheets("NLIST").Name = "NLIST"
sheets("NLIST").FieldNames = True
End with
no buenos
As always, any help would be appreciated
Edit1: Since it doesn't work, try creating the procedure in a module level and call it in your sheet code.
For example: This goes in a Module
Sub AddConnection(targetWS As Worksheet, INFILE As String)
With targetWS
With .QueryTables.Add(Connection:= _
"TEXT;" & INFILE, Destination:=.Range("$A$1"))
.Name = "NLIST"
.FieldNames = True
.PreserveFormatting = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileTabDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(8, 36, 2, 4, 7, 4, 4)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End With
End Sub
And then in your sheet code, you can call it like:
AddConnection Me, <FilePath> '/* if you are creating connection in that sheet */
or
AddConnection Sheets("NLIST"), <FilePath> '/* creating it on another sheet */
Not tested, no way to do it atm, but I think it should work.

Import *txt to a Worksheet and name it with the *txt file name

I'm trying to make a macro that could import *txt files from a folder and I did it. Now I'm stuck on this:
I need to name the worksheets with the same name as the *txt file. The actual code is importing as default names for new worksheets.
Sub ImportTXT()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("A:\REPORTS\2017\*.txt")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "A:\REPORTS\2017\" & strFile, Destination:=Range("$A$1"))
.Name = strFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 4, 4, 9)
.TextFileFixedColumnWidths = Array(14, 10, 6, 11, 43, 15, 33, 14, 1, 14, 16, 4, 13, 11, _
11, 10)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
Add a line of code after the add line
Set ws = Sheets.Add
ws.Name = strFile
With ws.QueryTables.Add(...
After "End With", try that:
Set ws = ThisWorkbook.ActiveSheet
ws.Name = Left(srtFile, Len(srtFile) - Len(".txt"))
srtFile = Dir
Final code:
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("A:\REPORTS\2017\*.txt")
Do While strFile <> vbNullString
Set ws = Sheets.Add
ws.Name = strFile
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "A:\REPORTS\2017\" & strFile, Destination:=Range("$A$1"))
.Name = strFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 4, 4, 4, 9)
.TextFileFixedColumnWidths = Array(14, 10, 6, 11, 43, 15, 33, 14, 1, 14, 16, 4, 13, 11, _
11, 10)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub

Import CSV files into Excel

I would like to ask for your help with the following:
I have CSV files exported from a software application that I need imported in Excel to analyse the data. Daily are generated 40-50 CSVs. For now I do this manually through "Get External Data from Text". The code recorded during the import is:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;SYSTEM:Users:catalin:Documents:LINELLA:WH Analytics:data:pick 01-18:050:Inquiry closed lists SKU_0142.csv" _
, Destination:=Range("A1704"))
.Name = "Inquiry closed lists SKU_0142"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMacintosh
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
.UseListObject = False
End With
Selection.End(xlDown).Select
Range("A1710").Select
I want to be able to import automatically all CSV files from a selected folder where I'll put new files and launch the import process. Each file should be inserted immediately after last row of the previous files.
Your help will be much appreciated.
Put the code you recorded in a function, replacing the static file name with a variable, then call that function for each *.csv file in the folder. The get the example below to work you need to save a file with this macro in the same folder as the csv files. For my quick test I had to replace the separator from ; to ,, and to remove the last row .UseListObject = False.
Sub ImportAllCSV()
Dim FName As Variant, R As Long
R = 1
FName = Dir("*.csv")
Do While FName <> ""
ImportCsvFile FName, ActiveSheet.Cells(R, 1)
R = ActiveSheet.UsedRange.Rows.Count + 1
FName = Dir
Loop
End Sub
Sub ImportCsvFile(FileName As Variant, Position As Range)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & FileName _
, Destination:=Position)
.Name = Replace(FileName, ".csv", "")
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMacintosh
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ","
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
End Sub

Excel txt file import (specific columns) into a table with VBA

I found this forum while I was trying to sort out my VBA code. I only have very little experience in VBA programming so far. That is why I have researched since two days for a solution for my problem, without success. However, I am very interested in impoving my programming skillsa and I hope you can help me to do so.
Basically I would like to import a TXT file into the active Excel workbook, sheet named "DataImport" at the end of the table named "TblDataImport".
The TXT file consists of 13 columns which are separated by tabs:
row: CompanyName
row: Date Name CustomerGroup CustomerNo SalesOrder ItemNumber ItemGroup LineStatus Quantity Price Discount DiscountPercentage NetAmount
row: All corresponding values...
I dont't need to import the first and the second row since the table where I would like to import the data to aready exists including headings. Also I only need 7 out of the 13 columns, those that are formated in bold. It would be perfect if the user could choose the text file using an open file dialogue.
If I open the TXT file manually and paste its content into Excel, it is already included
in the right columns. So there should not be any pitfalls with regard to formatting.
I am curious about the solutions you come up with.
With the macro recorder I can only fulfil some of my conditions:
Sub DataImport()
' DataImport Makro
Sheets("DataImport").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Sales.txt", Destination:=Range _
("$A$1"))
.Name = "AxaptaSales"
.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
.TextFileColumnDataTypes = Array(4, 1, 9, 9, 1, 9, 9, 9, 1, 1, 1, 9, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
However this code only pastes all columns into cell A1 (not at the end of the table). Also it includes the first and second row as well as the columns I don't need.
If you add the following to the code above this will add it to the end of the data already in the worksheet
Sub DataImport()
Dim LastRow As Integer
Dim LastRow2 As integer
LastRow = Range("A65536").end(xlup).row
LastRow = LastRow + 1
' DataImport Makro
Sheets("DataImport").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Sales.txt", Destination:=Range _
("$A" & LastRow))
.Name = "AxaptaSales"
.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
.TextFileColumnDataTypes = Array(4, 1, 9, 9, 1, 9, 9, 9, 1, 1, 1, 9, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("A" & LastRow & ":A" & LastRow + 1).entireRow.delete
LastRow2 = Range("A65536").end(xlup).row
Range("H" & LastRow & ":M" & LastRow2).entirecolumn.delete
End Sub
I think this should do as you require(But I am still a novice myself)

Resources