Text Import Wizard

  • Thread starter Thread starter Mike B
  • Start date Start date
M

Mike B

Is there an easy way of programmatically importing a
delimits text files (similar to the Text Import Wizard
but no dialog)? Fixed/Delimited, setting the delimiter,
etc.
 
-----Original Message-----
Is there an easy way of programmatically importing a
delimits text files (similar to the Text Import Wizard
but no dialog)? Fixed/Delimited, setting the delimiter,
etc.
.
Click to expand...

Yes--here's a snippet from something that does just that:


Set QuerySheet = Sheets.Add
With QuerySheet.QueryTables.Add(Connection:=FileAddress(i,
1), Destination:=QuerySheet.Range("A1"))
..TextFileCommaDelimiter = True
..Refresh BackgroundQuery:=False
End With

QuerySheet has been declared as Worksheet, i is the index
for a loop, and FileAddress is a string array containing
file addresses. For more info look up the Add method of
QueryTables in the VBA help files.

Robbie
 
Mike,

Got this from the forum (some time ago). Allows selecting more than one
file at a time. Opens the file and than saves it as a .xls into the same
folder from which it came. Amend as needed.

======================================
Sub OpenMyFile()
Dim GetFiles As Variant
Dim iFiles As Long
Dim nFiles As Long
Dim pth As String
Dim wbnm As String

'Open *.txt file and convert to *.xls
' for tab and , delimited text

Application.DisplayAlerts = False
Application.ScreenUpdating = False

On Error Resume Next
pth = ActiveWorkbook.path
ChDir pth
On Error GoTo 0

GetFiles = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt),*.txt", _
Title:="Select Files To Open", MultiSelect:=True)
If TypeName(GetFiles) = "Boolean" Then
''' GetFiles is False if GetOpenFileName is Canceled
MsgBox "No Files Selected", vbOKOnly, "Nothing Selected"
End
Else
'' GetFiles is Array of Strings (File Names)
'' File names include Path
nFiles = UBound(GetFiles)
For iFiles = 1 To nFiles
' List Files in Immediate Window
Workbooks.Open FileName:=GetFiles(iFiles)
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited,
_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo
_
:=Array(1, 1)

' saveas *.xls file in same folder
wbnm = ActiveWorkbook.Name
wbnm = Left(wbnm, Len(wbnm) - 4)
pth = ActiveWorkbook.path
ActiveWorkbook.SaveAs FileName:= _
pth & "\" & wbnm & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:=False _
, CreateBackup:=False

ActiveWindow.Zoom = 75
Range("A1").Select
Next
End If

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Back
Top