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
Related
I got an import csv code below
Private Sub Workbook_Open()
Dim xFileName As Variant
Dim Rg As Range
Dim xAddress As String
xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , , , False)
If xFileName = False Then Exit Sub
On Error Resume Next
xAddress = Range("A1").Address
With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Normally, it worked but when import csv but some kind of column that has start with 0 number, then excel treat that cell as Number and delete ( hide ) all 0 begin cell.
I've tried to add this script in but that not work.
ActiveSheet.NumberFormat = "#"
Have you tried format the destination field
Example
QueryTable.TextFileColumnDataTypes property
.TextFileColumnDataTypes = Array(xlTextFormat)
I want to import all the workbooks from this folder into the active sheet. (Path is in the code).
So far my code is this:
Option Explicit
Sub load_all_from_folder()
Dim idx As Integer
Dim fpath As String
Dim fname As String
idx = 0
fpath = "/Users/charliekeegan/Desktop/Tester1/"
fname = Dir(fpath & "*.csv")
While (Len(fname) > 0)
idx = idx + 1
Sheets("Sheet" & idx).Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& fpath & fname, Destination:=Range("A1"))
.Name = "a" & idx
.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 = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub
The macro runs but nothing happens in my active sheet - can you see the problem?
Also do you know how i can delete all the sheets after they have been uploaded?
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 am tring to write a script in vba for importing several text files to excel (one sheet) and than draw them on one graph.
I am facing a problem in Refresh BackgroundQuery commant and falls on 1004 run time error.
How can i work it out?
Thanks,
Eyal
Here is my code:
Sub fring1()
Dim fpath As String
Dim fname As String
Dim i As Integer
fpath = "C:\Users\epinkas\Desktop\Yossi\"
fname = fpath & "*.txt"
Name = Dir(fname)
While Name <> ""
With Sheet1.QueryTables.Add(Connection:= _
"TEXT;fpath & Name", _
Destination:=Range("$A$1"))
.Name = fpath & Name
.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 = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$A$1356")
Name = Dir()
Wend
End Sub
It looks like you are trying to use your path and filename variables inside a quoted string. Concatenate the variables into the quoted string.
With Sheet1.QueryTables.Add(Connection:= _
"TEXT;" & fpath & Name, _
Destination:=Range("$A$1"))
That should put the values of the variables into the string, not their variables names.
When importing multiple txt files via VBA into Excel I run into the an out of memory warning related to .Refresh BackgroundQuery:=False. At exactly 723 properly imported text files the error pops up.
This is the VBA code I use:
Sub Sample()
Dim myfiles
Dim i As Integer
myfiles = Application.GetOpenFilename(filefilter:="Text files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0))
.Name = "Sample"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "No File Selected"
End If
End Sub
How can I solve this?
I believe that this has to do with the cache size, page size and records per page. If you try the following code
objRecordset.Open "SELECT * FROM " & CSV_FILE, objConnection, adOpenStatic, adLockOptimistic, adCmdText
If Not objRecordset.EOF Then
intpagecount = objRecordset.PageCount
MsgBox intpagecount
MsgBox objRecordset.PageSize
Debug.Print objRecordset.CacheSize
end if
on a large CSV file, you'll find that VBA always shows a Memory Full error at the end of each page. In this case, there are 10 records per page, and 50585 pages. Sure enough, I get a memory full at each page 10*50585 = 505850 records.
You may have lots of connections in the workbook as you keep adding them but not deleting them afterwards.
Try this but run Sub CleanUpQT() first as a one off. Also, some of your ranges are not fully qualified which will cause problems if you change sheets while the code runs. Set whichever sheet you want this to operate on using Set ws = Sheet1 - where Sheet1 is the codename or similar.
Option Explicit
Sub Sample()
Dim myfiles As Variant
Dim i As Integer
Dim temp_qt As QueryTable
Dim ws As Worksheet
myfiles = Application.GetOpenFilename(filefilter:="Text files (*.txt), *.txt", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
Set ws = Sheet1
For i = LBound(myfiles) To UBound(myfiles)
Set temp_qt = ws.QueryTables.Add(Connection:= _
"TEXT;" & myfiles(i), Destination:=ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0))
With temp_qt
.Name = "Sample"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Set temp_qt = Nothing
CleanUpQT
Else
MsgBox "No File Selected"
End If
End Sub
Sub CleanUpQT()
Dim connCount As Long
Dim i As Long
connCount = ThisWorkbook.Connections.Count
For i = 1 To connCount
ThisWorkbook.Connections.Item(i).Delete
Next i
End Sub