Importer .txt-fil i Excel 97

Denne kode klarer problemet:

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, SepChar)
        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

Den indsætter tekst-filen præcis der, hvor du ønsker, hvorved du kan bibeholde dine formateringer.

Hvad med at bare at åbne den i ny fil, for så derefter at kopiere den med sine formateringer over i det eksisterende ark. Til sidst lukker du det nye dokument. ??

Fik ikke opdateret så.. undskyld!

Hej Jan,

Jeg tror jeg mangler funktionen ParseDelimitedString - jeg får i hvert fald en fejl om manglende funktion.

cyaegha-> Det har jeg prøvet, men det smadre formatteringen i det eksisterende ark (det er jo ikke tekst-filen, som er formatteret)

/Thomas

Jan->
Mangler også UpdateCells?!

Er det min Excel, der er noget i vejen med, eller mangler du at paste noget kode?

Du har ret! Den kommer her .....

Function ParseDelimitedString(InputString As String, SC As String) As Variant
\' returns a variant array containing each single item in InputString separated by SC
Dim i As Integer, tString As String, tChar As String * 1, sCount As Integer
Dim 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

Havde du også UpdateCells (og eventuelle andre)?

pfh tak :o)

Sikken jeg sover. Her er UpdateCells ....

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 Integer
    If TypeName(ActiveSheet) <> \"Worksheet\" Then Exit Sub
    r = 1
    c = 1
    On Error Resume Next
    c = UBound(TargetValues, 1)
    r = UBound(TargetValues, 2)
    Range(TargetRange.Cells(1, 1), TargetRange.Cells(1, 1).Offset(r - 1, c - 1)).Formula = TargetValues
    On Error GoTo 0
End Sub

Mangler du andre, så finder vi også dem! ;-)

Kanont, Jan :o)

Lortet virker sgu!!! Gracias :o)

/Thomas

Selvfølgelig virker det! :-)

Jeg kan såmænd også klare en \"ParseFixedString\", hvis din tekstfil skulle se lidt anderledes ud!

in that case, I\'l come back to you, thnx :o)

Hej Jan,

Jeg håber du læser dette ekstra-spørgsmål, som nok kun du kan svare på, da du har leveret koden.

Der er 60 ekstra point hvis du har et svar.

Den tekstfil, som jeg ønsker at importere viser sig at være i DOS-format (og ikke i Windows-format), således at ÆØÅ\'er bliver spoleret ved importen.

Har du en løsning på dette? Normalt når man importere en tekst-fil, kan man angive om det skal være DOS- eller Windows-format.

mvh Thomas

Jeg er på bar bund.

Har du ikke mulighed for i dit kildeprogram at angive om det skal være DOS eller Windows?

hmm, det er en gammel concorde/XAL, så jeg jed ikke lige hvilke muligheder der er. Jeg må prøve at se på det....

Tak for det ellers.

Hvis du kommer på en ide, må du meget gerne vende tilbage.

Forøvrigt: Det kode, som du gav mig lige før; virker det også i Excel 97 eller er det kun 2000? Jeg har ikke selv mulighed for at teste det på \'97 lige nu, så hvis du ved det, såå... :o)

Ja, det skulle også virke i Excel 97.

Jeg kigger også tit på concorde tekstudtræk.
Prøv denne makro. du vælger hvor teksten skal sættes ind ved at stille dig på en celle i det regneark der indeholder makroen.

Sub tryit()
D = \",\"  \'sæt delimiter
filnavn = Application.GetOpenFilename
Workbooks.Open filnavn, , , , 6, , , xlMSDOS, D
tekstfilnavn = ActiveWorkbook.Name
Selection.CurrentRegion.Select
Selection.Copy
Windows(ThisWorkbook.Name).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(tekstfilnavn).Close SaveChanges:=False
End Sub

Ovenstående makro virker i excel 97. I excel 2000 ville jeg nok vælge [data]/[hent eksterne data]/[tekstfiler]. der kan man også sætte ind hvor man ønsker

Hej Bak,

Jeg må sige, at din metode er en del mere simpel.
Men jeg får alle data i samme kolonne! Jeg har husket at sætte den rigtige delimiter (;).
hvordan kan det være?

Jeg har en anelse. prøv at sætte et 6 tal på pladsen før det det 6tal der allerede står der

Det virker sgu :o)

Tak for hjælpen

Her er dine point: http://www.eksperten.dk/spm/106683

/Thomas