|
|||||||||
These pages are no longer updated and are only available for archive purposes.Click here to visit the pages with updated information. Import from a delimited text fileThis macro imports data from a delimited text file to a worksheet range: Sub ImportRangeFromDelimitedText(SourceFile As String, SepChar As String, _
TargetWB As String, TargetWS As String, TargetAddress As String)
' Imports the data separated by SepChar in SourceFile to
' Workbooks(TargetWB).Worksheets(TargetWS).Range(TargetAddress)
' Replaces existing data in Workbooks(TargetWB).Worksheets(TargetWS)
' without prompting for confirmation
' Example:
' ImportRangeFromDelimitedText "C:\FolderName\DelimitedText.txt", _
";", ThisWorkbook.Name, "ImportSheet", "A3"
Dim SC As String * 1, TargetCell As Range, TargetValues As Variant
Dim r As Long, fLen As Long
Dim fn As Integer, LineString As String
' validate the input data if necessary
If Dir(SourceFile) = "" Then Exit Sub ' SourceFile doesn't exist
If UCase(SepChar) = "TAB" Or UCase(SepChar) = "T" Then
SC = Chr(9)
Else
SC = Left(SepChar, 1)
End If
' perform import
Workbooks(TargetWB).Activate
Worksheets(TargetWS).Activate
Set TargetCell = Range(TargetAddress).Cells(1, 1)
On Error GoTo NotAbleToImport
fn = FreeFile
Open SourceFile For Input As #fn
On Error GoTo 0
fLen = LOF(fn)
r = 0
While Not EOF(fn)
Line Input #fn, LineString
If r Mod 100 = 0 Then
Application.StatusBar = "Reading data from " & _
SourceFile & " " & _
Format(Seek(fn) / fLen, "0 %") & "..."
End If
TargetValues = ParseDelimitedString(LineString, SC) ' Excel 97 or older
'TargetValues = Split(LineString, SC, -1, vbBinaryCompare) ' Excel 2000 or later
UpdateCells TargetCell.Offset(r, 0), TargetValues
r = r + 1
Wend
Close #fn
Application.Calculation = xlCalculationAutomatic
NotAbleToImport:
' clean up
Set TargetCell = Nothing
Application.StatusBar = False
End Sub
Function ParseDelimitedString(InputString As String, SC As String) As Variant
' returns a variant array containing each single item in
' InputString separated by SC
' use the built-in Split function in Excel 2000 or later
Dim i As Integer, tString As String, tChar As String * 1
Dim sCount As Integer, ResultArray() As Variant
tString = ""
sCount = 0
For i = 1 To Len(InputString)
tChar = Mid$(InputString, i, 1)
If tChar = SC Then
sCount = sCount + 1
ReDim Preserve ResultArray(1 To sCount)
ResultArray(sCount) = tString
tString = ""
Else
tString = tString & tChar
End If
Next i
sCount = sCount + 1
ReDim Preserve ResultArray(1 To sCount)
ResultArray(sCount) = tString
ParseDelimitedString = ResultArray
End Function
Sub UpdateCells(TargetRange As Range, TargetValues As Variant)
' Writes the content of the variable TargetValues to
' the active worksheet range starting at TargetRange
' Replaces existing data in TargetRange without prompting for confirmation
Dim r As Long, c As Long, i As Long
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
r = 1
c = 1
On Error Resume Next
c = UBound(TargetValues, 2) - LBound(TargetValues, 2) + 1
r = UBound(TargetValues, 1) - LBound(TargetValues, 1) + 1
Range(TargetRange.Cells(1, 1), _
TargetRange.Cells(1, 1).Offset(r - 1, c - 1)).Formula = TargetValues
On Error GoTo 0
End Sub
Document last updated 2006-08-28 15:58:23 Printerfriendly version
|
|||||||||
|
|||||||||