Makro der henter eksisterende tekstfil

Prøv med nedenstående. Forudsætter at data starter i kolonne A, og at der ikke er tomme rækker. Ret filnavn og sti for filen der skal importeres. Forudsætter også at der ikke er overskrifter i txt filen.

Sub Import()
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Activate
    a = Selection.Address

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Dokumenter\impo.txt", _
        Destination:=Range(a))
        .Name = "impo"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .Refresh BackgroundQuery:=False
    End With

End Sub

Kan man det jkrons?
eftersom du bruger den "samme" tekstfil (navn) hver gang, vil du så ikke få en forkert opdatering af de data der står overover ?

overover=ovenover

bak-> Som jeg opfatter det, er det ikke de samme data fra gang til gang. Jeg har læst det som nye data, siden de skal tilføjes i bunden af de eksiterende. Disse skal ikke ændres. Han bruger bare samem filnavn til at gemme dem i, inden eksport. Men jeg kan selvfølgelig tage fejl.

JKrons-> jeg har ikke testet det, men du laver en query på en textfil hver gang.
Det, jeg er lidt betænkelig ved, er om de foregående query's også vil blive opdateret, således at du vil få flere gange samme data.
Måske opdateres de ikke og så er alt jo godt.

Korrekt jkrons jeg har en applikation som smider nye data i samme filnavn. De data der er i tekstfilen vil blive overskrevet!

Jeg prøver lige dit eksempel se om det virker efter hensigten!

Jkrons, jeg har nu testet. Der sker ingen opdering af allerede hentede data, så din makro er fin.. :-)  , beklager jeg blandede mig :-(

jkrons>> Det virker ikke

Den hopper til række 65536 i kollonne A - hvor efter den giver mig en fejl med mulighed for end og debug...

Melder fejl i denne linie:
    ActiveCell.Offset(1, 0).Activate

prøv lige at skrive overskrifter i række 1, så virker den.

beklager, række 2

Ok så virker det efter at der er lidt data i forvejen!

Men den autotilpasser kolonnen til dataen der bliver hældt i, hvordan får man den til at lade være med det?

Og kan man lave sådan at den bruger det ark der hedder data i stedet for det aktive ark?

Du kan så vidt jeg ved kun importere til det aktive ark, men du ka så aktivere arket først:

Indsæt denne linie først i koden:
Worksheets("data").Activate

Autotilpas skulle du kunne undgå ved at ændre linien:
.AdjustColumnWidth = True

til False i stedet for True.

Jkrons>> Det er bare perfekt, nu virker det!

Hvis du vil forklare hver enkelt linie i scriptet hvad de gør er der 15 point mere at hente!

Tough Job, men jeg prøver. Så håber jeg bare at du kan bruge forklaringerne til noget :-)

Sub Import()
’Først vælges det aktuelle ark - i dette tilfælde data
    Worksheets("data").Activate

’Så skal vi sikre at vi starter i A1
    Range("A1").Select

’Herfra går vi til sidste celle, der er udfyldt i A-kolonnen
    Selection.End(xlDown).Select

’Og så yderligere en celle ned, for at komme til en tom celle
    ActiveCell.Offset(1, 0).Activate

’Så gemmer vi denne celles adresse til senere brug
    a = Selection.Address

’Så er vi klar til selve importen. Først skal vi have fat importfilen
’og samtidigt skal vi bestemme hvor den skal placeres. Dette gøres
’med Destination:=Range(a), hvor a er adressen vi tidligere gemte
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Dokumenter\impo.txt", _
        Destination:=Range(a))

’De følgende linier kode svarer til de indstillinger man kan foretage i Guiden tekstimport.
’De steder, hvor der står True, svarer det til at noget er valgt i Guiden.
’Står der False, svarer det til, at det IKKE er valgt.

’Navn på inputområdet. Tilsyneladende samme navn som importfilen har, men det kan ændres.
        .Name = "impo"

’Første linie indeholder IKKE overskrifter, ellers = True
        .FieldNames = False

’ Skal eventuelle rækkenumre i kildefilen importeres med
        .RowNumbers = False

’Skal efterfølgende kolonner fyldes med formler
’Sættes til True, hvis celler ved siden af importområdet
’indeholder formler, der skal kopieres ned til de nye data
        .FillAdjacentFormulas = False

’Skal eksisterende celleformat bevares
        .PreserveFormatting = True

’Skal forespørgslen køres igen når filen åbnes
        .RefreshOnFileOpen = False

’Der indsættes ny celler til de importerede data. Ikke anvendte celler slettes.
’Her er flere andre muligheder - se Guiden
        .RefreshStyle = xlInsertDeleteCells

’Skal en eventuel adgangskode gemmes
        .SavePassword = False

’Skal forespørgselsdata gemmes
        .SaveData = True

’Tilpas kolonnebredde?
        .AdjustColumnWidth = False

’Skal forespørgslen køres automatisk. Angiv interval i minutter
        .RefreshPeriod = 0

’Alle de følgende linier beskriver egenskaber ved importfilen

’Skal der spørges om et nyt filnavn ved automatisk opdatering
        .TextFilePromptOnRefresh = False

’Hvilket format er datafilen i (Her Windows ANSI
        .TextFilePlatform = xlWindows

’Start import ved kildefilens række nr. I dette tilfælde række 1.
        .TextFileStartRow = 1

’Kildefilen er en separeret fil.
        .TextFileParseType = xlDelimited

’Dobbelte anførselsten angiver tekststrenge
        .TextFileTextQualifier = xlTextQualifierDoubleQuote

’Skal efterfølgende separatorer opfattes som én ?
’Mest interessant ved brugerdefinerede separatorer bestående af flere tegn
        .TextFileConsecutiveDelimiter = False

’Er separatoren en tabulator
        .TextFileTabDelimiter = True

’Er separatoren et semikolon
        .TextFileSemicolonDelimiter = False

’Er separatoren et komma
        .TextFileCommaDelimiter = False

’Er separatoren et mellemrum
        .TextFileSpaceDelimiter = False

’Beskriver antallet af kolonner i importfilen (tror jeg). 1 tal pr. kolonne.
        .TextFileColumnDataTypes = Array(1, 1)

’Skal forespørgslen opdatere i baggrund
        .Refresh BackgroundQuery:=False
    End With

End Sub

Og hvor der står ’ skulle der have stået ' som kommentarindikator. Sådan går det når man prøver at bruge Word som editor.

Du skal have tusind tak jkrons, det hjalp mig meget!

Du har fortjent dine point, og i dagens anledning er de 15 ekstra point blevet til 30 ekstra point :-)

Velbekomme! Tak for point.

Lige et enkelt tillægs spørgsmål, håber du kan og vil besvare det :-)

Kan jeg efter import slette indholdet af filen, for at sikre at der kun kommer poster ind der ikke er blevet hentet ind før?

Du kan i hvert fald slette hele filen, om du også kan slette indholdet og lad filen stå tilbage kan jeg ikke lige gennemskue.

Så skal du bare tilføje denne linie lige før End Sub

Kill ("C:\Dokumenter\impo.txt")

Men du skal være sikker på at din import er gået godt, så måske skal den "pakkes ind" i noget bekræftelse af hvorvidt sletningen SKAL gennemføres, fx

ans = MsgBox("Skal importfilen slettes nu?", vbYesNo + vbQuestion, "Sletteadvarsel")
If ans = vbYes Then
Kill ("C:\Dokumenter\impo.txt")
Else
Exit Sub
End If

Den metode fungerer fint! Men det ville være bedst at inden import at vi så kunne tjekke om filen eksisterer, kan vi det?

Smid dette ind lige efter Sub...

FileExist = Dir("C:\Dokumenter\impo.txt")
If FileExist = "" Then
MsgBox "Der eksisterer ingen importfil. Importen afbrydes", vbOKOnly + vbInformation, "Filfejl"
Exit Sub
End If

Det er kanon - du skal have mange tak for hjælpen!

Velbekomme!

Håber I stadig lytter i dette spørgsmål

Kan makroen tilpasses så den virker i Excel 97 også?

I øjeblikket melder den fejl når den køres i excel97 ved denne linie:

With ActiveSheet.QueryTables.Add(Connection:="TEXT;c:\delfi\data\strawberry.txt", _
        Destination:=Range(a))


Bladrede lidt rundt i menuerne, og det ser ud til at funktionen ikke findes i excel...

Der er selvfølgelig ekstra point hvis det kan lade sig gøre :-)

Jee har desværre ikke længere adgang til Excel97, og min hukommelse er ikke god nok til at huske hvad der var supportet dengang. Sorry!

Hvis hele Importfunktionen er ny i 2000 (og det kan godt tænkes) kan du erstatte hele din kode i 97 med følgende - noget primitive metode. Den åbner importfilen i Excel og kopierer hele indholdet over til det ark, den skal sættes ind i. Derefter lukkes importfilen igen. Kontrol for om filen findes, samt sletning af filen er bebeholdt fra det oprindelige forslag.

Løsningen er noget mere primitiv - og lidt langsommere. Til gengæld burde den virke såvel i 2000/XP som i 97.

Sub mysub()
    FileExist = Dir("C:\Dokumenter\import2.txt")
    If FileExist = "" Then
        MsgBox "Der eksisterer ingen importfil. Importen afbrydes", vbOKOnly + vbInformation, "Filfejl"
    Exit Sub
    End If
    Workbooks.OpenText Filename:="C:\Dokumenter\import2.txt"
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Windows("importertilark.xls").Activate
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Windows("import2.txt").Close
    ans = MsgBox("Skal importfilen slettes nu?", vbYesNo + vbQuestion, "Sletteadvarsel")
    If ans = vbYes Then
        Kill ("C:\Dokumenter\import2.txt")
        Else
        Exit Sub
    End If
 
End Sub

Tusind tak skal du have - jeg tester det lige i morgen, så får du nogle flere point hvis det virker! :-)

Helt i orden :-)  Test væk!

Jeg skulle måske lige sige, at import2.txt selvfølgelig er tesktfilen, mens importertilark.xls er den fil, der skal importeres til, og som indeholder koden.

jkrons>> Det virker perfekt - med en enkelt undtagelse...

Hvis der i en kolonne ikke står noget data vil den stoppe her!

eks.

jeg har en fil der ser sådan ud: (Der hvor der er komma er der tab i filen)

1,4,5,6,,5

Den stopper her efter 4 kolonne og tager derfor ikke den sidste med!

Kan det lade sig gøre at gøre sådan at den altid tager til og med kolonne F, i stedet for bare hvor der ikke er data mere?

Dette virker selv om der er tomme kolonner i importfilen under forudsætning af, at den altid går til kolonne F, og at den ikke indeholder helt tomme rækker.

Sub mysub()
    FileExist = Dir("C:\Dokumenter\import2.txt")
    If FileExist = "" Then
        MsgBox "Der eksisterer ingen importfil. Importen afbrydes", vbOKOnly + vbInformation, "Filfejl"
    Exit Sub
    End If
    Workbooks.OpenText Filename:="C:\Dokumenter\import2.txt"
    Range("A1").Select
    Selection.End(xlDown).Select
    Adr = ActiveCell.Row
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1:F" & Adr).Select
    Selection.Copy
    Windows("importertilark.xls").Activate
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Windows("import2.txt").Close
    ans = MsgBox("Skal importfilen slettes nu?", vbYesNo + vbQuestion, "Sletteadvarsel")
    If ans = vbYes Then
        Kill ("C:\Dokumenter\import2.txt")
        Else
        Exit Sub
    End If
 
End Sub

Ja så virker den perfekt! :-)

Men en enkelt undtagelses! I den tekstfil jeg vil importere indgår en formel i et af felterne! Denne formel bliver bare skrevet i feltet uden at blive "eksekveret". De står bare som tekst i feltet!

Er det muligt at få det lavet sådan så denne formel bliver eksekveret?
Altså så det / de felter med formeler bliver lavet om fra tekstfelt til formel!

Hvordan ser formlerne ud?

Og står de altid samme sted?

Eks. ser formlen ud som sådan: =INDIREKTE("A1")

Ja de står altid i kolonne F

Og hvad står der så i A1? Når jeg prøver at indsætte hos mig virker formlen glimrende.

Et tal :-) - min formel er lidt mere kompleks end som så!

Et eksempel på en række i tekstfilen kunne være:

5678    030327    07:34    2        =(INDIREKTE(ERSTAT(ERSTAT(ADRESSE(RÆKKE();4);1;1;"");2;1;""))*Priser!B3)+(INDIREKTE(ERSTAT(ERSTAT(ADRESSE(RÆKKE();5);1;1;"");2;1;""))*Priser!B4)

Hvis der altid er tale om den samme formel, kan følgende måske løse dit problem

Sub mysub()

    FileExist = Dir("C:\Dokumenter\import2.txt")
    If FileExist = "" Then
        MsgBox "Der eksisterer ingen importfil. Importen afbrydes", vbOKOnly + vbInformation, "Filfejl"
    Exit Sub
    End If
    Workbooks.OpenText Filename:="C:\Dokumenter\import2.txt"
    Range("A1").Select
    Selection.End(xlDown).Select
    Adr = ActiveCell.Row
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1:F" & Adr).Select
    Selection.Copy
    Windows("importertilark.xls").Activate
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Windows("import2.txt").Close
    r = Selection.Address
    For Each c In Worksheets("ark1").Range(r).Cells
    cv = c.Value
    If Left(cv, 1) = "=" Then
    c.FormulaR1C1 = "=(INDIRECT(REPLACE(REPLACE(ADDRESS(ROW(),4),1,1,""""""""),2,1,""""""""))*Priser!R[-1]C[-3])+(INDIRECT(REPLACE(REPLACE(ADDRESS(ROW(),5),1,1,""""""""),2,1,""""""""))*Priser!RC[-3])"
    End If
    Next c
    ans = MsgBox("Skal importfilen slettes nu?", vbYesNo + vbQuestion, "Sletteadvarsel")
    If ans = vbYes Then
        Kill ("C:\Dokumenter\import2.txt")
        Else
        Exit Sub
    End If
 
End Sub

Det er samme formel i alle kolonner - det er bare vigtigt at de begge alle bliver ganget med henholdsvis B3 og B4 i arket priser og at den ikke bliver forskubbet!

Jeg tester det i morgen og giver der nogle ekstra point der :-) Du har redeligt fortjent dem

Takker :-)

Formlen jeg har lavet arbejder med relative referencer, så jeg prøver lige at ændre lidt.

Linjen c.FormulaR1C1 = skal udskiftes med

c.Formula = "=(INDIRECT(REPLACE(REPLACE(ADDRESS(ROW(),4),1,1,""""""""),2,1,""""""""))*Priser!b3)+(INDIRECT(REPLACE(REPLACE(ADDRESS(ROW(),5),1,1,""""""""),2,1,""""""""))*Priser!b4)"

Det ser nice ud :-) Som sagt jeg vil teste det i morgen!

Hvad har du så ændret?

Er det nu sådan at den tager formlen og smider ind i kolonne F? og det er henholdvis B3 og B4 som bliver brugt hele vejen ned?

Det er i hvert fald det, der er hensigten :-)

Mange tak jkrons :-)

Dit script virker perfekt nu, med en enkelt undtagelse... Der er lidt for mange " i formlen som vil melde fejl #REFERENCE, men det er rettet - og det kører perfekt nu!

Du kan hente dine velfortjente point her: http://www.eksperten.dk/spm/336263

Endnu engang velbekomme -  og tak!

Jeg har lige et spørgsmål.
Hvis nu jeg kun ønsker de linier importeret hvor f.eks "wq=" fremkommer i importfilen?
Hvordan klarer jeg lige det? Jeg laver lige et nyt spørgsmål på http://www.eksperten.dk/spm/724057