Oprettet søn. d. 25. juli 2010 kl. 17:12:59

mrkr
mrkr (3.230 point. Point ude: 260)

Importere data fra flere filer i en mappe

Jeg har et ark hvor jeg manuelt importerer data ind i, fra nogle kommaseparerede filer der alle ligger i mappen c:\import\

Kan det lade sig gøre at lave en kode der importerer data fra alle de filer der ligger i mappen c:\import\

Herefter ville det være super hvis filerne kunne flyttes til c:\import\ErImporteret\

så man ikke kommer til at indlæse dataene mere end en gang.

Alle filerne hedder .txt til efternavn.

Dataene som importeres i arket skal importeres så de bliver indsat efter hinanden i arket IMPORT

Når jeg optager en makro over min import ser den ud som vist nedenfor, men det løser desværre ikke mit problem med at der skal indlæses fra flere filer.

Er der nogen der kender til en sådan løsning.

Sub imp()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;c:\import\kladde.txt", Destination:=Range("$A$1"))
        .Name = "kladde"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Skrevet søn. d. 25. juli 2010 kl. 17:22:09| #1

supertekst
supertekst (119.444 point)
supertekst-it.dk
Ja - men har ikke tid lige nu...

Skrevet man. d. 26. juli 2010 kl. 22:16:46| #2

Til første spørgsmål.

Du kan starte med at lave en løkke der kigger i mappen via kommandoen DIR. Derefter laver du en løkke der angiver hvert navn i din importfunktion.

Det kan anbefales at importere i en liste (array), som er langt hurtigere og du kan nemmere overskue hvor meget du har importeret.

Skrevet ons. d. 11. august 2010 kl. 22:20:49| #3

mrkr
mrkr (3.230 point)
Hej Gnowak

tak for tipppet.
Mit problem er bare at jeg ikke kan finde ud af at lave løkker og indlæse i en array :-)

Når jeg ser koder fra jer experter kan jeg som regel finde ud af at lave mindre rettelser selv, men jeg kan under ingen omstændigheder finde ud af at bygge en kode som denne op fra bunden, desværre.

Skrevet man. d. 16. august 2010 kl. 11:59:28| #4

supertekst
supertekst (119.444 point)
supertekst-it.dk
REM Sub "ImporterEnFil" skal tilpasses iflg. din spec.

Const importMappeNavn = "C:\Import\"
Const erImporteretMappeNavn = "C:\ErImporteret\"

Public Sub importer()
Dim fs, f, f1, fc
Dim filSti As String, filNavn As String, indsætIcelle As String, ræk As Long

Rem traverser import-mappen
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(importMappeNavn)
    Set fc = f.Files
   
    For Each f1 In fc
        filNavn = f1.Name
        filSti = f1.Path
        ræk = Range("A65536").End(xlUp).Row
        If ræk > 1 Then
            ræk = ræk + 1
        End If
       
        indsætIcelle = "$A$" & CStr(ræk)
       
        importerEnFil filSti, filNavn, indsætIcelle
    Next
   
    flytImporteredeFiler
   
    MsgBox "Import er udført"
End Sub
Private Sub importerEnFil(filSti, filNavn, indsætIcelle)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filSti _
        , destination:=Range(indsætIcelle))
        .Name = filNavn
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Private Sub flytImporteredeFiler()
Dim fs, f, f1, fc
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(importMappeNavn)
    Set fc = f.Files
   
    For Each f1 In fc
        FileCopy importMappeNavn & f1.Name, erImporteretMappeNavn & f1.Name
        Kill importMappeNavn & f1.Name
    Next
End Sub

Skrevet tor. d. 26. august 2010 kl. 18:07:37| #5


Skrevet tor. d. 21. oktober 2010 kl. 15:29:51| #6

mrkr
mrkr (3.230 point)
Så fik endelig tid til at sætte mig ned og teste på det.
Det virker fuldstændig som det skal.

Beklager den lange svartid, men jeg har været arbejdet alt alt for meget i den sidste tid :-(

Mange tak for hjælpen.

Skrevet tor. d. 21. oktober 2010 kl. 15:38:15| #7


Skriv et indlæg




Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] [img]link til billede[/img]
Web- og emailadresser omdannes automatisk til links

Log ind

   

   

Seneste spørgsmål

Svar til: X i en celle giver et andet resultat i anden...

Oprettet den 11. februar 2012 kl. 14.15
ashurra giver 100 point for svar | Giv et svar »

Hjælp til formel rente/antal dage

Oprettet den 11. februar 2012 kl. 12.14
petert giver 30 point for svar | Giv et svar »

Problemløser, "HVIS" formel, eller andet til optimering?

Oprettet den 11. februar 2012 kl. 02.36
Olav123 giver 150 point for svar | Giv et svar »

Seneste guides

Installer win 7
Den gode bruger


   




Tips & Tricks fra PC World

Teaser billede

Her er fem sjove danske websider du skal kende

Trænger dine lattermuskler til en omgang fitness på dansk? Vi viser vej til fem websider fyldt med humor og vanvittig satire.


Anmeldelser fra PC World

Teaser billede

Test: Denne super-tablet er iPads hårdeste konkurrent

Eee Pad Transformer Prime er frygtindgydende med sin quadcore processor og evne til at trylle sig om til bærbar. Apple bør kigge i bagspejlet, for Asus' tablet-pc kommer buldrende - og gør det...


Seneste blogindlæg

Teaser billede

Tvangslukke spørgsmål: Hvad er den bedste løsning?

Hej Vi har mange åbne spørgsmål på Eksperten. Vi ville gerne tvangslukke dem - så et spørgsmål efter f.eks. 6 måneder lukkes. Men der er et par uklarheder som ville være gode at få lidt input til:...


Nyheder fra PC World

Teaser billede

Nu kan du snart hente Windows 8

Den nye offentlige betaversion af Windows 8 er klar i denne måned.


Nyheder fra Computerworld

Teaser billede

Måske snart slut med Androids helt store problem

Android-platformen har længe været plaget af et særligt problem. Men måske er problemet nu ved at være elimineret.


Kurser
Samarbejdspartnere

Udgiver · © 2012 IDG Danmark A/S · Hørkær 18 · 2730 Herlev · Tlf.: 77 300 300 · Fax: 77 300 301 · Brug af personoplysninger