Error parsing CSV to XLS with VBA script - vba

This function is designed to open a CSV file, and import all the data into a specific Sheet on an Excel Workbook.
But I think there is some kind of problem I can't resolve in some cases with delimiters.
This is my function:
Sub LoopAllExcelFilesInFolder_Invenotry()
Dim strFilename As String
Dim wsMstr As Worksheet: Set wsMstr = ThisWorkbook.Sheets("ALL_ACTIUS")
If MsgBox("Erase sheet before start importing?", vbYesNo, "Delete?") _
= vbYes Then wsMstr.UsedRange.Clear
strFilename = Application.GetOpenFilename _
(FileFilter:="CSV File (*.csv), *.csv", _
Title:="Select CSV file: ")
Worksheets("ALL_MACHINES").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strFilename, _
Destination:=Range("A1"))
.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
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
This is part of the source code (CSV file), containing a line that is not beeing "translted" as expected:
Here you can see how this line is translated to the Excel. The 12X5" string should'nt be there. The first column should only contain IP addresses.
I'm pretty sure It's a delimiter character issue, but I can't find the solution.

The Workbooks.Open command worked for me with that issue.
Dim wb As Workbook
strFilename = "yourfilename.csv"
Set wb = Workbooks.Open(Filename:=strFilename, local:=True)

Related

VBA Code: How to reject a file import if the name isn't in sequential order?

I have yearly data files (text delimited) that will each be named "2016 latest", "2017 latest", "2018 latest", etc. I have a macro written that will bring up the file window and allow the user to chose the file and then automatically import it into the workbook. However, I want to include some error control that will reject the file and endsub if, for example, the last file uploaded was "2016 latest" and the file they try to upload is "2018 latest". I'm trying to prevent years from being duplicated or years from being skipped. How would I do this? I've attached the code I have so far.
Option Explicit
Sub ImportTextFile()
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Dim fName As String, LastRow As Long
fName = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fName = "False" Then Exit Sub
LastRow = Range("A" & Rows.Count).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
Destination:=Range("A" & LastRow))
.Name = "sample"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = True
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False
End With
Selection.EntireRow.Delete
End Sub

Run time error 1004 excel cannot find the text file to refresh this external range

I'm trying to convert tsv files in a folder to xlsx format by importing them as text file using Data=>From Text option via VBA.
During that encountered this error
Code:
Sub convert()
Dim CSVfolder As String, XlsFolder As String, fname As String, wBook As Workbook
CSVfolder = ActiveSheet.Range("B2").Value & "\"
fname = Dir(CSVfolder & "*.tsv")
Do While fname <> ""
Workbooks.Add
Set wBook = ActiveWorkbook
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("$A$1"))
.Name = fname
.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 = xlTextQualifierNone
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
wBook.Close False
fname = Dir
Loop
End Sub
End Sub
Why i'm getting the error in .Refresh BackgroundQuery:=False ?
The error is happening there as it's at the Refresh stage that it looks for the file.
The issue is that Fname won't contain the path.
Change your connection to:
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & CSVfolder & fname, Destination....

Import multiple CSV files into master excel spreadsheet and append the data to previous imports

I have a script that imports a .csv file into worksheet "Data"
After the first import all following ones appear to the right of the previous imports and not added onto the bottom (last row).
I think the issue involves this area of the script:
Destination:=ThisWorkbook.Sheets("Data").Range("$A$1"))
Sub load_csv()
Dim fStr As String
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
Exit Sub
End If
'fStr is the file path and name of the file you selected.
fStr = .SelectedItems(1)
End With
With ThisWorkbook.Sheets("Data").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=ThisWorkbook.Sheets("Data").Range("$A$1"))
.Name = "CAPTURE"
.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 = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
You need to examine the destination to see what the next unused cell is.
With ThisWorkbook.Sheets("Data")
.QueryTables.Add(Connection:= _
..., Destination:=.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'lots of other stuff
End With
You can rereference the ThisWorkbook.Sheets("Data") repeatedly but using a With ... End With statement is easier.

400 Error Message when closing File Dialog box

I'm using the below code to get a file location. I'm using the file location of GetFile in a separate code that imports CSV data to one of my sheets.
The problem I'm running into is when the File Dialog Box opens up, if I don't select a file and click cancel I get a 400 error message. Can someone please let me know how to get rid of this error message?
Function GetFile() As String
Dim filename__path As Variant
filename__path = Application.GetOpenFilename(FileFilter:="Csv (*.CSV), *.CSV", Title:="Select File To Be Opened")
If filename__path = False Then Exit Function
GetFile = filename__path
End Function
As suggested in the comments below, the problem doesn't seem to lie in the function but in the macro calling on the function and receiving an error when it's false. The macro code is posted below; I've tried variations of GetFile = False to end the with statement but keep getting errors one way or the other.
Sub Import_log()
ActiveWorkbook.Sheets("Bus List Import").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & GetFile, Destination:=.Range( _
"$A$1"))
.Name = "logexportdata"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(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
ActiveWorkbook.Sheets("Master").Activate
End Sub
For now I'm using the code 'On Error GoTo MasterTab:' above with the MasterTab: label above the line to change the active sheet to the Master tab. I know this isn't best practice so I'd love if anyone had an answer :)
Here's full code below:
Sub Import_log()
ActiveWorkbook.Sheets("Bus List Import").Activate
On Error GoTo MasterTab:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & GetFile, Destination:=Range( _
"$A$1"))
.Name = "logexportdata"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(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
MasterTab:
ActiveWorkbook.Sheets("Master").Activate
End Sub
if no file is selected you probably want to stop your macro. Then replace
If filename__path = False Then Exit Function
with
If filename__path = False Then End
exit function won't stop your macro and if you call GetFile from another function, it will throw an error if you're trying to do something with GetFile = vbNullString or another unexpected value
The correct way to handle this is
Sub Import_log()
Dim filename__path As Variant
'...
filename__path = Application.GetOpenFilename(FileFilter:="Csv (*.CSV), *.CSV", Title:="Select File To Be Opened")
If Not filename__path = False then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & filename__path, Destination:=Range( "$A$1"))
'... Your code
End With
End If
End Sub

Importing csv to Excel, CSV

I have a excel 2007 workbook , with current worksheet named 'a' Now what I want is,
When user clicks a button in sheet a, it should ask,
Which csv file to import,
Ask for name of that new sheet user want (where that csv file is to be placed).. Say to simplify user says 'b' now.
After that copy 'sheet a' into the new sheet b.
Import the csv into that new sheet, comma delimted, and allow overwriting of existing cells in copied sheet.
What can be basic start level code to accomplish all these tasks?
I will be grateful for any help in this regard.
Thanks
Sal
Try this:
Public strFile As String
Sub Main()
Dim WS As Worksheet
strFile = Application.GetOpenFilename("Excel workbooks,*.csv*")
If strFile = "False" Then
' the user clicked Cancel
Else
y = Right(strFile, Len(strFile) - InStrRev(strFile, "\", -1, vbTextCompare))
zz = Left(y, InStr(1, y, ".", vbTextCompare) - 1)
flag = 0
For k = 1 To Worksheets.Count
If Sheets(k).Name = zz Then
flag = 1
End If
Next
Set WS = Sheets.Add(After:=Sheets(Worksheets.Count))
If flag = 0 Then
WS.Name = zz
Else
MsgBox ("Sheet with same name already exist. Imported to default sheet")
End If
importcsv
End If
End Sub
Sub importcsv()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & strFile, Destination:=Range( _
"$A$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 = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub