I have a VBA script to import txt file. It works well on Excel 2013.
On excel 2016, getopenfilename does not support argument anymore (excel crash). It works when removing all arguments of getopenfilename()
Any idea ?
Sub Import_TXT()
On Error GoTo Err1
With Sheets("Sheet2").QueryTables.Add(Connection:= _
"TEXT;" & GetTXT, Destination:=Sheets("Sheet2").Range("A1"))
.Name = "logexportdata"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Exit Sub
Err1:
MsgBox "Data not imported. Error: " & Err.Number & vbCrLf & Err.Description
End Sub
Function GetTXT() As String
Dim filename__path As Variant
' Get the filename
filename__path = Application.GetOpenFilename(FileFilter:="TXT (*.txt), *.txt", Title:="Select txt file")
If filename__path = False Then Exit Function
GetTXT = filename__path
End Function
The solution I found is to replace by
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Text file", "*.txt", 1
.FilterIndex = 1
.Title = "Select txt file"
.Show
filename__path = .SelectedItems(1)
End With
Related
I have adapted a code I found on here, which pulls in text files and pastes the data into new sheets. This file is supposed to name the sheets the name of the text file, but my text file names are too big. It seems excel sheets can be 31 characters long. How can I adjust this code to name the sheets using the first 31 characters of the text file names?
I would also like for the code to prompt me to pick the folder destination. I've tried a few things, but haven't figured it out yet.
Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "I:\path\" & 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 = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
.TextFileFixedColumnWidths = Array(22, 13, 13)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
Change .Name = strFile to
If Len(strFile) < 31 Then
.Name = strFile
Else
.Name = Mid(strFile, 1, 31)
End If
Use the LEFT() function to only get the first 31 characters of your filename, like so:
Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "I:\path\" & strFile, Destination:=Range("$A$1"))
.Name = LEFT(strFile,31)
.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 = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
.TextFileFixedColumnWidths = Array(22, 13, 13)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
I managed to figure out how to get it to prompt for a folder location, but neither of the above suggestions worked. The sheets are still getting default labels.
Sub ImportManyTXTs_test()
Dim foldername As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
foldername = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
Dim strFile As String
Dim ws As Worksheet
strFile = Dir(foldername & "\" & "*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & foldername & "\" & strFile, Destination:=Range("$A$1"))
.Name = Left(strFile, 31)
.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 = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
.TextFileFixedColumnWidths = Array(22, 13, 13)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
' using for each loop
For Each ws In ThisWorkbook.Sheets
ws.Rows("1:45").NumberFormat = "#"
ws.Rows("1:45").Replace _
What:="=", Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
Next
For Each ws In ThisWorkbook.Sheets
If Not IsEmpty(ws.Cells(16, 2).Value) Then
ws.Name = ws.Cells(16, 2).Value
End If
Next
I managed to solve my problem by adding this to the end of my code. My data files have a header which unfortunately uses a lot of "=" making excel import those items as equations. The instrument name is in the header which is what I want the sheets to be labelled.
Not sure why naming after file name wouldn't work.
I want to be able to click a button and select the file I want to import. I've done this but after it says my file has been imported nothing happens.
What am i missing?
Sub GetImportFileName()
Dim Filt As String
Dim Title As String
Dim FileName As Variant
Dim FilterIndex As Integer
Filt = "Comma Separated Files (*.csv),*.csv,"
FilterIndex = 5
Title = "Select a File to Import"
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
Title:=Title)
If FileName = False Then
MsgBox "No file was selected."
Exit Sub
End If
MsgBox "You selected " & FileName
End Sub
I don't see any code that would import the CSV. You only acquire the FileName. You are missing something like this ( Comma (,) as delimiter)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fileName & "", Destination:=Range("$A$1" _
))
.CommandType = 0
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Here is my code and all works except I am unable to insert data to the last blank in the active worksheet.
Sub load_csv()
Dim fStr As String
Dim nextrow As Long
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
Set nextrow = Range(Cells(Rows.Count, "A").End(xlUp).Row + 1) ' THIS IS FAILING
With ThisWorkbook.Sheets("TEST").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=**nextrow**)
.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
Set nextrow = Cells(Rows.Count, "A").End(xlUp).Offset(1)
I have a macro enabled excel workbook that contains several named worksheets. One of the worksheets is named "panel" and a second worksheet is named "data". The sheet named "panel" has a button to which a macro is assigned. I would like to select the button on the worksheet named "panel" and have a browse for file window appear. Once the user selects the csv file on their hard drive, I would like the contents of the csv file to be imported into the worksheet named "data" starting in cell A1.
PROBLEM 1: The vba I have assigned to the button causes the contents of the csv file to be placed on the same worksheet as the button (the "panel" worksheet). I would like the contents of the csv file to be placed on the "data" sheet.
PROBLEM 2: Also, there is a string of code referencing my hard drive and a file called "capture.csv". So when macro enabled excel file is on another computer, the file crashes. Any way to remove the pathway string so any computer could use the file?
Any assistance to fix this issue would be greatly appreciated. The macro assigned to the button follows:
Sub load_csv()
Dim fStr As String
With Application.FileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
End
End If
'fStr is the file path and name of the file you selected.
fStr = .SelectedItems(1)
End With
Range("A1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\laptop\Desktop\CAPTURE.csv", Destination:=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
MsgBox fStr
End With
End Sub
Is this what you are trying?
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:=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
For Excel on Mac, it seems the QueryTable object does not support the properties "PreserveFormatting" and "RefreshPeriod" and will give you a runtime error if you try and set them.
Also, Application.FileDialog does not work with Mac either, but that is covered in other posts.
For Mac:
Sub load_csv()
Dim fStr As String
fStr = "Macintosh HD:Users:anthony:Documents:example.csv" 'Keeping file String simple for example.
With ThisWorkbook.Sheets("Data").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=Range("$A$1"))
.Name = "CAPTURE"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
'.PreserveFormatting = True **commented out for Mac
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
'.RefreshPeriod = 0 **commented out for Mac
.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
I am running a macro which automatically takes csv files and import them into specific worksheets in my workbook. However, I would want to add greater flexibility by having the user select the files for import rather than have the macro automatically grab the csv files because the naming could change as well as the directory. I am new to VBA and have been trying to better understand the MsoFileDialogType and GetOpenFilename but having difficulty trying to grasp the concept/implementation into my code.
What I ultimately want is for the user to click a button on the workbook front-end. Be prompted with a message to select the first csv file for import. This csv file will be imported into a pre-named worksheet in the workbook temp1. However since the data files come in pairs, I want the user to be able to select the next csv file after the first one into temp2.
What I have currently is:
Worksheets.Add
ActiveSheet.Name = "temp1"
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;MAC Directory path here" _
, Destination:=Range("A1"))
.Name = "temp 1 03.02.12"
.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 = 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, 1, _
1, 1, 1)
.Refresh BackgroundQuery:=False
.UseListObject = False
End With
ActiveSheet.Move after:=Worksheets(Worksheets.Count)
Thank you.
Perhaps something on these lines.
Sub GetCSVList()
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
.AllowMultiSelect = True
''Start in
.InitialFileName = "Z:\docs\"
.Show
End With
For Each fname In dlgOpen.SelectedItems
ImportCSV fname
Next
End Sub
Sub ImportCSV(fname)
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
ws.Name = "temp" & Worksheets.Count + 1
With ws.QueryTables.Add( _
Connection:="TEXT;" & fname, _
Destination:=Range("A1"))
.Name = "Temp" & Worksheets.Count + 1
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.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 = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.Refresh BackgroundQuery:=False
'.UseListObject = False
End With
End Sub