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

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

Related

TXT connectivity issue

I Have recoded a code using the Record button.
Basically, I need to remove all special characters using 65001 in File Origin.
I have run a script that converts the .txt in 65001 formats and applies Text to columns as well. Because I need to open .txt data in an excel file
But the problem is the script is run perfectly fine for the 1st TXT file but But for the remaining .txt Text to column function doesn't apply.
Str = "TEXT;" & myFile
With ActiveSheet.QueryTables.Add(Connection:=Str, destination:=Range("$A$1"))
.Name = "UK"
.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 = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = 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, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
End With
I don't know the exact issue. Please find the attahced image as well the formating of 1st and the remainging txt data in excel file.
As you can see in 1st image there is noting after the heading "Letest deleivery date". But for the remain format there are data not perfectly extracted from txt to excel.
Please check and let me know the reason.
Since you're always adding a new querytable, try removing any existing ones first.
Dim Str
Str = "TEXT;C:\Tester\tmp.txt"
'remove any existing querytable(s) and clear associated range
Do While ActiveSheet.QueryTables.Count > 0
With ActiveSheet.QueryTables(1)
Debug.Print "Clearing querytable at ", .ResultRange.Address
.ResultRange.Clear
.Delete
End With
Loop
With ActiveSheet.QueryTables.Add(Connection:=Str, Destination:=Range("$A$1"))
.Name = "UK"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells 'this is better I think
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = 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, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=True
End With

How to paste data into a table without moving data?

I made a program that should copy and paste data from SAP saved in a text file, in an excel file except that when I start the program the table I made moves and the data sticks next to it.
I'm providing you with the piece of code that I think is problematic.
Sub OpenCSVFile()
' Load the CSV extract
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fpath & "\" & ffilename, Destination:=Range("$A$1"))
.Name = "text"
.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 = 4
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(9, 9, 9, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
I want to paste my data inside my table without moving my table and thus without sticking them next to it.
Before:
After:

Excel VBA Text File Import Is Blank

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

Excel Macro, data written to text file in quotes

I am writing a macro to automate and expedite data processing with Agilix.
The problem i am having is that when the macro, as shown in the code below, surrounds all the written information in quotation marks.
This isn't a problem when I write .txt with it, however i now have to generate a .xml from it and the quotation marks screw it up.
Here is the macro that writes to the .txt
'
Sub DataOutDataIn(REQ As String)
' Sends the raw data out to notepad then returns it reformatted
'
'Specify data target location
Dim myFile As String
myFile = Application.DefaultFilePath & "\DataForReturn.txt"
'Open file and export raw data
Open myFile For Output As #1
Write #1, Range("A10").Value
Close #1
'Clear data parsing page and extract the reformatted data
Sheets("Data For Parsing").Select
Cells.Select
Selection.ClearContents
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\me\Documents\DataForReturn.txt", Destination:=Range("$A$1"))
.Name = "DataForReturn_3"
.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 = 3
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.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, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
'
Can anyone tell me why it surrounds with quotes and how to fix it?
Replace the Write statement with Print

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

Resources