Home > Excel VBA makroer > Hvordan man importerer en tekstfil

Importer en tekstfil med Excel VBA

Med Excel VBA kan man både skrive og importere tekstfiler. Dette eksempel viser, hvordan man kan importere en semikolon-separeret tekstfil til et regneark i Excel. Semikolon bruges til at opdele tekst og tal i regnearkets celler. Linieskift signalerer en ny række.

Det meste af koden har jeg sakset på nettet engang. Det kan sikkert gøres smartere, men dette virker fint for mig. Den styrende procedure er Sub ImportDelimitedText(), mens funktionen ParseDelimitedString og proceduren UpdateCells "læser" teksten og fordeler den i regnearkets celler. Se også hvordan man skriver en tekstfil med VBA.

Sub ImportDelimitedText()
'Importerer teksten adskilt af sSepChar i sSourceFile til
'Range(sTargetAddress). Overskriver ældre data.
'Normalt vil denne procedure blive kaldt af en anden,
'som så samtidig videregiver info om tekstfilens navn
'og sti (sSourceFile), separatortegn (sSepChar) og evt.
'celleadressen (sTargetSddress), hvor teksten skal sættes ind.

Dim sDel As String * 1
Dim LineString As String
Dim sSourceFile As String
Dim sSepChar As String
Dim sTargetAddress As String
Dim rTargetCell As Range
Dim vTargetValues As Variant
Dim r As Long
Dim fLen As Long
Dim fn As Integer

On Error GoTo ErrorHandle

'Importfilen og dens placering
sSourceFile = "C:\filtest.txt"

'Separatortegn (delimiter)
sSepChar = ";"

'Startcelle for placering af data
sTargetAddress = "A1"

'sSourceFile eksisterer ikke
If Len(Dir(sSourceFile)) = 0 Then Exit Sub

'Identificerer delimiter
If UCase(sSepChar) = "TAB" Or UCase(sSepChar) = "T" Then
   sDel = Chr(9)
Else
   sDel = Left(sSepChar, 1)
End If

'Importér data
Worksheets(1).Activate

'Sætter startcellens adresse
Set rTargetCell = Range(sTargetAddress).Cells(1, 1)

'Sletter evt. gamle data
rTargetCell.CurrentRegion.Clear

On Error GoTo BeforeExit

'Får et frit nummer af operativsystemet
fn = FreeFile

'Åbner filen for input
Open sSourceFile For Input As #fn
On Error GoTo 0
fLen = LOF(fn)
r = 0
While Not EOF(fn)
   Line Input #fn, LineString
   'Kalder funktionen, som skal læse teksten.
   vTargetValues = ParseDelimitedString(LineString, sSepChar)
   'Skriver til celler
   UpdateCells rTargetCell.Offset(r, 0), vTargetValues
   r = r + 1
Wend

'Lukker tekstfilen
Close #fn

BeforeExit:
'Rydder op
Set rTargetCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i ImportDelimitedText."
Resume BeforeExit
End Sub

Den følgende funktion "læser" teksten.

Function ParseDelimitedString(InputString As String, _
sDel As String) As Variant
'Returnerer et variant array indeholdende hvert element
'i InputString adskilt af sDel.

Dim i As Integer, iCount As Integer
Dim sString As String, sChar As String * 1
Dim ResultArray() As Variant

On Error GoTo ErrorHandle

sString = ""
iCount = 0
For i = 1 To Len(InputString)
   sChar = Mid$(InputString, i, 1)
   If sChar = sDel Then
      iCount = iCount + 1
      ReDim Preserve ResultArray(1 To iCount)
      ResultArray(iCount) = sString
      sString = ""
   Else
      sString = sString & sChar
   End If
Next i

iCount = iCount + 1
ReDim Preserve ResultArray(1 To iCount)
ResultArray(iCount) = sString
ParseDelimitedString = ResultArray

Exit Function
ErrorHandle:
MsgBox Err.Description & " Fejl i funktionen ParseDelimitedString."
End Function

Den følgende procedure skriver teksten i regnearkets celler.

Sub UpdateCells(rTargetRange As Range, vTargetValues As Variant)
'Skriver indholdet i variablen vTargetValues
'til det aktive faneblad begyndende i rTargetRange.
'Eksisterende data overskrives.

Dim r As Long, c As Integer

On Error GoTo ErrorHandle

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
r = 1
c = 1

On Error Resume Next

c = UBound(vTargetValues, 1)
r = UBound(vTargetValues, 2)
Range(rTargetRange.Cells(1, 1), rTargetRange.Cells(1, 1). _
Offset(r - 1, c - 1)).Formula = vTargetValues

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i UpdateCells."
End Sub

Relateret