Ja - men har ikke tid lige nu...
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.
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.
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
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.