Kære eksperter - er der mon nogen, der kan hjælpe mig.
Jeg tror, det er let, men ved bare ikke, hvordan.
Jeg har en mappe (der f.eks. hedder "Datamappe") fuld af datafiler i ASC-format.
De hedder eksempelvis A_1.ASC A_2.ASC A_3.ASC
etc.
Jeg vil gerne lave en makro, der kan importere alle filer i "Datamappe" på én gang. Alle må gerne være i samme excel-sheet adskilt af tre tomme kolonner mellem hver importeret dataserie (som i mit aktuelle tilfælde også består af 3 kolonner).
Jeg har prøvet at bruge makro-optageren og får følgende kode, som kun kan hente den ene og samme fil, som jeg hentede under optagelsen:
Jeg har set andre steder, at for at få fat på FLERE filer med én makro kan man blandt andet bruge kommandoer som:
FilePath = "C:\WINDOWS\Desktop\Datamappe
FileSpec = "A_*.xls"
Set FS = Application.FileSearch
With FS .LookIn = FilePath .Filename = FileSpec .SearchSubFolders = False 'Søg ej underfoldere .Execute 'If .FoundFiles.Count = 0 Then ' MsgBox ("Ingen filer fundet") ' Exit Sub ' End If End With
For i = 1 To FS.FoundFiles.Count Workbooks.Open Filename:=FS.FoundFiles(i)
osv. - men, jeg ved slet ikke, hvordan det kan sættes op, for at virke....
dette er ikke færdigt, da jeg ikke ved, hvordan man løbende finder ud af, hvor næste frie plads er. Med ellers noget som:
Sub Import_af_flere_filer() ' ' Import_af_flere_filer Macro ' ' Keyboard Shortcut: Ctrl+i ' FilePath = "S:\A-PRD\A-T\LHK\Test_af_import\Datamappe" FileSpec = "A_*.asc" Set FS = Application.FileSearch With FS .LookIn = FilePath .Filename = FileSpec .SearchSubFolders = False 'Søg ej underfoldere .Execute 'If .FoundFiles.Count = 0 Then ' MsgBox ("Ingen filer fundet") ' Exit Sub ' End If End With
For i = 1 To FS.FoundFiles.Count ' destinationrange skal rettes på en eller anden måde elers kommer alle filer ind samme sted. With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & FilePath & "\" & FS.FoundFiles(i), Destination:=Range("$A$3")) ' name = filnavn minus .asc .Name = left(FS.FoundFiles(i),len(FS.FoundFiles(i)-4)) .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 = True .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Range("A1").Select Next i 'kan godt være der kun skal stå Next End Sub
der skal man finde sidst brugte række, og lægge 3 til - det tal gemmes i en variabel (fx StartHer) som skal have startværdien 3. Variablen kan så sættes ind i Range("$A$3")) så det bliver fx Range("$A$" & StartHer))
... End With StartHer=3 For i = 1 To FS.FoundFiles.Count With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & FilePath & "\" & FS.FoundFiles(i), Destination:=Range("$A$" & StartHer)) ...
stadig med den manglende beregning ved slutningen.
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
