[Løst] Excel 2007 VBA Importere Txt og xls

[Bigelk]

Hei.

 

Jeg har en kode som brukes til og importere som jeg har lyst til og forbedre.

 

Jeg importerer en txt fil og en xls fil.

Jeg har satt det opp sånn at jeg kjører samme koden etter hverandre,

så etter jeg har valgt txt filen kommer det automatisk opp et vindu så jeg kan velge xls filen.

 

'Importerer .txt
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
End With

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

 

Men det jeg vil er at når brukeren har valgt txt filen som feks. heter "Desember"

så søker den automatisk etter xls filen som også heter "Desember"

og importerer den uten at brukeren må velge den.

 

Å hvis det er mulig, hvis man har lagret xls filen med en skrivefeil "Desenber" så kommer det opp et vindu, (filen du du søker etter finnes ikke, Vennligst velg selv)

 

er det noen som veit hvordan man kan få til det?

 

Bare si i fra hvis det trengs en mer utfyllende forklaring

 

MVH

 

Torbjørn

Endret 11. mai 2012 av Bigelk

[Harald Staff]

Hei Torbjørn

 

Hvis jeg forstår deg rett:

 

   project2 = Replace(project, ".txt", ".xls")

   If Dir(project2) = "" Then

    MsgBox project2 & " finnes ikke"

   Else

    MsgBox project2 & " eksisterer"

   End If

[Bigelk]

_{Hei igjen Harald.}

_{Jeg har ikke prøvd koden din, fordi jeg vet ikke helt hvordan jeg skal skrive den inn i den koden jeg har, men hvis jeg forstår deg rett så tror jeg ikke du forstår meg rett}

 

_{Hvis jeg forstår koden din, så isteden for og importere begge filene, så erstatter den txt filen med xls filen?}

_{Jeg vil velge en fil, og importere 2 hvis de har likt navn.}

 

_{Så, hvis jeg tar feil og det er det koden din gjør, Hvordan skriver jeg koden din inn i den koden jeg har?}

 

_{Tusen Takk for hjelpen}

[Harald Staff]

Behold koden din til og med at tekstfilen er ferdig importert. Etter det er spørsmålet om det finnes en xls-fil med samme navn, og det er hva koden min sjekker. Hvis det gjør det kan du glemme fil-dialogen i andre ledd og gå rett på import, hvis ikke må brukeren finne filen selv. Med andre ord, dette er kode for å fylle project2 med en gyldig filbane.

 

Jeg kan ikke bli mer konkret fra en iPad...

 

beste hilsen Harald

[Bigelk]

Hei.

 

Har testa den litt nå, fungerer som en drøm

Legger ut hele koden når jeg har fin justert litt.

 

Tusen takk for hjelpen Harald

[Bigelk]

Hei.

 

Da ble det sånn her

Sheets(1).Select
   Dim IntPath$, project$, pickf As Object
   IntPath = "//filserver/tope/bonus"
   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

   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 ".xls File", "*.xls", 1: .ButtonName = "Import file": .Title = "Search for .Xls 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

[Harald Staff]

Flink gutt, Torbjørn!

[Bigelk]

Hei.

 

Hvis jeg har 3 txt filer som skal importeres. alle starter med f.eks 0606. Går det ann og gjøre det tilsvarende da?

Jeg har 3 txt filer

0606,500

0606,350

0606,bring

 

Så når jeg da velger 0606,500 med musa så importerer den også 0606,350 og 0606,bring?

 

Mvh

 

Torbjørn