[Løst] Excel 2007 VBA Importere to txt filer med samme navn lagret i 2 forskjellige mapper

[Bigelk]

Hei.

 

Jeg har brukt en kode til og importere 2 forskjellige rapporter som er lagret i samme mappe, den ene var xls og den andre var txt. (rapportene har samme navn) F.eks 1408.txt 1408.xls

Nå har det blitt gjort noen justeringer og begge rapportene blir lagret som txt.

 

Jeg tenker derfor at jeg lagrer de i 2 forskjellige mapper.

 

Med koden jeg har brukt tidligere har jeg valgt txt filen, så har den importert xls filen automatisk. nå vil jeg da velge den første txt filen fra mappe 1 å så hente den andre txt filen med samme navn fra mappe 2 automatisk.

 

et utklipp av koden som jeg bruker til å hente txt filen

Sheets(1).Select
ActiveSheet.Select
Dim IntPath$, project$, pickf As Object
IntPath = Sheets("Ver").Range("G1")
Set pickf = Application.FileDialog(msoFileDialogFilePicker)
With pickf
.InitialView = msoFileDialogViewDetails: .InitialFileName = IntPath: .Filters.Clear: .Filters.Add "Pick .txt File", "*.txt", 1: .ButtonName = "Import file": .Title = "Search for .txt file to Import"
If .Show = -1 Then
project = .SelectedItems(1)
Else: GoTo SubExit
End If
End With
Range("A2:AZ500").ClearContents
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& project, Destination:=Range("A1"))
.RefreshStyle = xlInsertDeleteCells
.Refresh BackgroundQuery:=False
'ny kode
End With

/[code]

 

koden som henter inn xls filen automatisk

[code]

Sheets(2).Select
project2 = Replace(project, ".txt", ".xls")

If Dir(project2) = "" Then 'project2 & " finnes ikke"
MsgBox "Finner ikke filen med tilsvarende navn. Vennligst velg en fil selv"
Set pickf = Application.FileDialog(msoFileDialogFilePicker)
With pickf
.InitialView = msoFileDialogViewDetails: .InitialFileName = IntPath: .Filters.Clear: .Filters.Add ".txt File", "*.txt", 1: .ButtonName = "Import file": .Title = "Search for .txt file to Import"
If .Show = -1 Then
project = .SelectedItems(1)
Else: GoTo SubExit
End If
End With
Range("A2:AZ500").ClearContents
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& project, Destination:=Range("A1"))
.RefreshStyle = xlInsertDeleteCells
.Refresh BackgroundQuery:=False
End With

Else 'project2 & " eksisterer"
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& project2, Destination:=Range("A1"))
.RefreshStyle = xlInsertDeleteCells
.Refresh BackgroundQuery:=False
End With
End If

/[code]

 

Er det mulig og justere koden så den istedenfor går inn i mappe 2 og henter txt fil med samme navn?

 

Bare si i fra hvis forklaringen ikke er bra nok

 

MVH

 

Torbjørn

[Bigelk]

Hei.

 

Løste den.

 

Mappe 1 heter Olfi, Mappe 2 heter Wintid.

 

Etter å ha lest igjennom koden et par ganger skjønte jeg at variabelen project/project 2 "lagret" hele filbanen.

 

Så project = L:\Plukk Statistikk\Rapporter\Olfi\1308.txt

 

Jeg tenkte at project bare inneholdt navnet på filen som skulle importeres. 1308.txt

 

Siden begge filene heter det samme gjorde jeg om koden til

 

project2 = Replace(project, "Olfi", "Wintid")

Da vil Project2 = L:\Plukk Statistikk\Rapporter\Wintid\1308.txt

og importere filen som har det samme navnet som den første importen.

 

MVH

 

Torbjørn