excel vba open dialog to import csv - vba

I have this vba code below that was generated by the macro recorder. It imports a csv file into the current excel sheet with some specific column settings. Right now the path to the csv file is hard coded to "C:\Users\myuser\Desktop\logexportdata.csv". How can I change this so that there is a dialog prompt that asks the user to find the .csv file for import?
Sub Import_log()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\myuser\Desktop\logexportdata.csv", Destination:=Range( _
"$A$2"))
.Name = "logexportdata"
.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 = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(5, 2, 2, 2, 2, 2, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub


try this:
Sub Import_log()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & getFile, Destination:=Range( _
"$A$2"))
.Name = "logexportdata"
.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 = 2
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(5, 2, 2, 2, 2, 2, 9, 9, 9, 9, 9)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
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

Related

How to maintain spaces while importing data from notepad/text

I am importing data into excel from text file, but upon import the spacing changes. How to code so as to maintain the spacing same as text file. Basically I will use this spacing to convert text to columns.
Text fileenter image description here
Upon import to excel
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\1538544\Desktop\CIB\3\1114744500_A0000076849_SOIL.txt", _
Destination:=Range("$A$1"))
.Name = "1114744500_A0000076849_SOIL"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 932
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.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
End Sub

Run time error 5 Invalid procedure call in macros

I am trying to import text file using macros but i am like getting the error 5, invalid procedure call. I have tried recording the macro and re ran but it is showing that error at the "commandtype" line. I could not find out the reason. Any help is appreciated
Sub Macro1()
'
' Macro1 Macro
'
'
Application.DisplayAlerts = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\491840\Desktop\IE11 scripts link.txt", Destination:=Range( _
"$A$1"))
.CommandType = 0
.Name = "IE11 scripts link"
.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, 1, 1)
.TextFileFixedColumnWidths = Array(10, 17, 21, 16)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.DisplayAlerts = True
End Sub

I think it is trying to do a process with an incompatible file type. Try removing the commmandtype line and then rerunning. Hopefully that works

Open source path file from activecell VBA

"This code can open source file with any path .. but now I have the list of source path files on sheet1 and I want to open the file on active cell.. How should I fix this code ? "
Dim Ret
Ret = Application.GetOpenFilename("All Files (*), *")
Sheet2.Activate
If Ret <> False Then
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Ret, 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 = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If

Assign the value of the ActiveCell to Ret.
Ret = ActiveCell.Value
Then check if the returned path is valid. Something like:
If Dir(Ret) <> "" Then
'~~> rest of your code here
Else
MsgBox "Invalid Path"
'~~> or do something else
End If
HTH.

VBA Excel Import delimited txt file when having a partial file name

This seems like a simple task, but I can't put my finger on it, it just won't work.
I need to import a delimited txt file by vba, that has a random value at the end, this is what I tried:
c02 = Dir("T:\bla\DERP-_-" & Format$(Date, "YYYY-MM-DD") & "_*.txt")
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & c02 _
, Destination:=Range("$A$1"))
.Name = _
"Extract"
.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 = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
So the full path for today would be: T:\bla\DERP-_-2014-06-19_08-19.txt
Tomorrow could be: T:\bla\DERP-_-2014-06-20_09-12.txt
Why won't this work? I'm so frustarted that something this simple is not working
Huuuuge thanks in advance

You need to add the full path to where your querytable is being generated. Dir only returns the filename, not the full path

Importing Files Into Excel - Skip if not Found

This is my first question here, I have a macro to import .txt files "Semicolon" delimited into Excel. Each file is name specific, and each file is imported in a new sheet. But if one of theses files doesn't exists, the macro Fails. I want to add an "On Erro" to handle these cases, if the file doesn't exists, skip it. Heres the code:
Sub Importar_Dep()
Dim Caminho As String
Caminho = Sheets("DADOS").Cells(5, 8).Value
Sheets("DEP").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Caminho, _
Destination:=Range("$A$1"))
.Name = "RECONQUISTA_DEP_0"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Here is your code with the check if the file exist:
Sub Importar_Dep()
Dim Caminho As String
Caminho = Sheets("DADOS").Cells(5, 8).Value
Sheets("DEP").Select
'+++++ Added block to check if file exists +++++
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
Dim TextFile_FullPath As String
'The textfile_fullPath should be like:
TextFile_FullPath = "C:\Users\Username\Desktop\" & _
RECONQUISTA_DEP_0 & _
".txt"
If FS.FileExists(TextFile_FullPath) Then
'++++++++++++++++++++++++++++++++++++++++++++++++
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Caminho, _
Destination:=Range("$A$1"))
.Name = "RECONQUISTA_DEP_0"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub
Like in your comment, if you want to run through all files that have a certain name in common (a filter), you can use this code. The above modifications have then became useless because with this you don't have to check if file exists anymore since it will just go through all existing files. You could have to check if the folder exists though:
Sub RunThroughAllFiles()
Dim Caminho As String
Caminho = Sheets("DADOS").Cells(5, 8).Value
Sheets("DEP").Select
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
Dim Filter As String: Filter = "RECONQUISTA_DEP_*.txt"
Dim dirTmp As String
If FS.FolderExists(Caminho) Then
dirTmp = Dir(Caminho & "\" & Filter)
Do While Len(dirTmp) > 0
Call Importar_Dep(Caminho & "\" & dirTmp, _
Left(dirTmp, InStrRev(dirTmp, ".") - 1))
dirTmp = Dir
Loop
Else
MsgBox "Folder """ & Caminho & """ does not exists", vbExclamation
End If
End Sub
Sub Importar_Dep(iFullFilePath As String, iFileNameWithoutExtension)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & iFullFilePath, _
Destination:=Range("$A$1"))
.Name = iFileNameWithoutExtension
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
For more information see Dir, FileExists and FolderExists

Here:
Sub Abrir_PORT()
Dim Caminho As String
Caminho = Sheets("DADOS").Cells(5, 5).Value
Sheets("PORT").Select
Dim FS
Set FS = CreateObject("Scripting.FileSystemObject")
Dim Filter As String: Filter = "ATENTO_TLMKT_REC*.txt"
Dim dirTmp As String
If FS.FolderExists(Caminho) Then
dirTmp = Dir(Caminho & "\" & Filter)
Do While Len(dirTmp) > 0
Call Importar_PORT(Caminho & "\" & dirTmp, _
Left(dirTmp, InStrRev(dirTmp, ".") - 1))
dirTmp = Dir
Loop
End If
End Sub
Sub Importar_PORT(iFullFilePath As String, iFileNameWithoutExtension)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & iFullFilePath, _
Destination:=Range("$A$1"))
.Name = iFileNameWithoutExtension
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
iRow = 2
Do While Sheets("PORT").Cells(iRow, 1) <> ""
If Cells(iRow, 2) = IsNumber Then
Else
Rows(iRow).Select
Selection.EntireRow.Delete
iRow = iRow - 1
contagem = contagem + 1
End If
iRow = iRow + 1
Loop
End With
End Sub