VBA: .Refresh Run-Time Error - excel

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

Related

Importing all workbooks from a folder (VBA - Mac)

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?

Import CSV files into Excel/ Dir function is not working

I'm used this great resource Import CSV files into Excel, and it was working great last week, but this week i can't get it to work.
What changed?
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
Call KopieraUnikaRaderBlad
Call RaderaLine
Call SammanStall
Call SidforNummer
End Sub
' Sub för att importera csv fil info till blad med namn från filnamnet
Sub ImportCsvFile(FileName As Variant, Position As Range)
Dim newString As String
Dim char As Variant
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & FileName _
, Destination:=Range("$A$1"))
.Name = "A00-40---1-D02------ Klar_allt"
.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
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
' det som är in kopierat några kolumner tas bort
Columns("C:I").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
newString = Right(FileName, 25)
'fixar till bladnamnet
For Each char In Split(SpecialCharacters, ",")
newString = Replace(newString, char, "")
Next
ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub
This must be Excel "default" location that changed, or you moved the csv files.
You macro Sub ImportAllCSV() will only work if you have files in the current directory.
To be sure, one solution is to use the complete path, e.g.
fName = "C:\local\my_existing_file.csv"
Otherwise, with your formula, FName = Dir("*.csv") calls to the directory Excel considers as "default". This is the directory you have when going to File > Open...
If you want to be sure of current path, then try Re-Initializing "ThisWorkbook.Path", like with the below:
Set CurrWB = Workbooks("the_current_workbook_you_want.xlsm")
directory = currwb.path
FName = Dir(directory & "\*.csv")
This is the answer
Sub ImportAllCSV()
Dim FName As Variant, R As Long
Application.ScreenUpdating = False
R = 1
Set CurrWB = Workbooks("Bok1.xlsm")
directory = CurrWB.Path & "\"
FName = Dir(directory & "*.csv")
Do While FName <> ""
ImportCsvFile FName, ActiveSheet.Cells(R, 1), directory
R = ActiveSheet.UsedRange.Rows.Count + 1
FName = Dir
Loop
Call KopieraUnikaRaderBlad
Call RaderaLine
Call SammanStall
Call SidforNummer
Call KollaFlyttaData
'Call RäknaData
Application.ScreenUpdating = True
End Sub
Sub ImportCsvFile(FileName As Variant, Position As Range, directory As Variant)
Dim newString As String
Dim char As Variant
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & directory & FileName _
, Destination:=Range("$A$1"))
.Name = "A00-40---1-D02------ Klar_allt" 'vet inte vad den här linjen gör verkar som inget
.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
.TextFileOtherDelimiter = ";"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
.WorkbookConnection.Delete
End With
' det som är in kopierat några kolumner tas bort
Columns("C:I").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
newString = Right(FileName, 25)
'fixar till bladnamnet
For Each char In Split(SpecialCharacters, ",")
newString = Replace(newString, char, "")
Next
ActiveSheet.Name = Left(newString, Len(newString) - 3)
End Sub

Excel: Import files using VBA and name sheets after file name that is too long

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.

importing a csv file into a workbook

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

run time error 1004 in excel 2010 Refresh BackgroundQuery

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.

Resources