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.
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 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
I am having a problem with some VBA code. I'm running Excel 2010 on Windows 7 Enterprise.
I'm trying to read in several tab-delimited text files from a folder and put them onto separate sheets in one Excel workbook. To do this, I'm using a Query Table. In debugging, I have a problem with .Refresh BackgroundQuery:=False. When it reaches this line, it throws a 1004 run-time error, stating that Excel cannot find the text file to refresh this external data range. I don't know why this is occurring. I know that the Query Table isn't created until it reads this line, which makes debugging difficult. Here is the code. Any help would be much appreciated. Thanks in advance!
Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fname As String
idx = 0
fname = Dir("C:\files\*.txt")
While (Len(fname) > 0)
idx = idx + 1
Sheets("Sheet" & idx).Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & 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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub
Here is the correction:
Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fpath As String
Dim fname As String
Dim f_dummy As String
idx = 0
fpath = "C:\files\"
f_dummy = fpath & "*.txt"
fname = Dir(f_dummy)
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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub
Change the line With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("A1"))
to
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & "C:\files\" & fname, Destination:=Range("A1"))
You fname just has the name of the file and not the full path
Also avoid using .Select and fully qualify your Objects.
INTERESTING READ
Your code can be written as
Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fname As String, FullName As String
Dim ws As Worksheet
idx = 0
fname = Dir("C:\*.txt")
While (Len(fname) > 0)
FullName = "C:\" & fname
idx = idx + 1
Set ws = ThisWorkbook.Sheets("Sheet" & idx)
With ws.QueryTables.Add(Connection:="TEXT;" & _
FullName, Destination:=ws.Range("A1"))
'
'~~> Rest of the code
'
fname = Dir
End With
Wend
End Sub
I've been attempting to import multiple large text files onto multiple spreadsheets within the same workbook. Thanks to other posts on this site, I have cobbled together some VBA code that seems to do the job. Only problem is that since the data are unlabelled within the text files, it is difficult to tell them apart for analysis. As such, I would like to label each spreadsheet with the corresponding text file during the import process. The code I'm using is as follows.
Thanks!
Sub ImportManyTXTs()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\test\*.txt")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "I:\test\" & 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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileFixedColumnWidths = Array(7, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
Edit: Managed to figure it out. Just added ws.Name = strFile after End With. Seems to work quite well.
Managed to figure it out. Just added ws.Name = strFile after End With. Seems to work quite well.