Gå til innhold

[Løst] åpne filbane ved bruk av makro, velge hvilken fil som skal importeres med musa


Anbefalte innlegg

Hei.

 

Jeg skal importere forskjellige type filer inn i min aktive arbeidsbok. jeg bruker i dag en makro som åpner filbanen og jeg kan velge hvilken fil som skal åpnes med musa. men det jeg trenger er at den importerer filen jeg velger inn i den Aktive arbeidsboken og i et spesifikk ark. informasjonen som filen inneholder må også sorteres.

 

 

Dette er makroen jeg bruker

Dim FileName As Variant
  Dim Filt As String, Title As String
  Dim FilterIndex As Integer, Response As Integer
  ChDrive "H:\"
  ChDir "H:\tonn"
  Filt = "All Files (*.), *."
  FilterIndex = 5
  Title = "Please select a different File"
  FileName = Application.GetOpenFilename(FileFilter:=Filt, _
  FilterIndex:=FilterIndex, Title:=Title)
  If FileName = False Then
  Response = MsgBox("No File was selected", vbOKOnly & vbCritical, "Selection Error")
  Exit Sub
  End If
  Response = MsgBox("Du valgte " & FileName, vbInformation, "Proceed")
  Workbooks.Open FileName

Hvis noen har en annen type løsning som også kan fungere så ta jeg gjerne imot tips.

 

Porblemstilling:

 

Hvordan velge hvilken fil som skal importeres til aktiv arbeidsbok? På en brukervennlig måte

 

Håper det var en god nok forklaring på problemet

Endret av Bigelk
Lenke til kommentar
Videoannonse
Annonse

Hei.

 

Jeg har "ordnet" det, men ikke på den måten jeg egentlig er ute etter,

Så jeg vil ikke sette tråden som LØST

 

Jeg har akkurat startet med programmering så beklager hvis det er litt dårlig forklart :)

 

Her er Makroen jeg bruker.

'Fjerner innholdet i Ark olfi så det er "klart" til og ta i mot den nye informasjonen
Sheets("Olfi").Select
   Range("A1:I100").Select
   Range("I100").Activate
   Selection.ClearContents
   Range("A1").Select

'Åpner filbanen så man kan velge hvilken fil som skal importeres med musa
'oppretter en ny Arkfane lengst til høyre med informasjonen som har blitt importert.
'''Tror den gjør dette ved og åpne en ny Arbeidsbok så Kopiere den Arkfanen som inneholder informasjon _
og deretter lime inn den Arkfanen i den aktive arbeidsboken
Dim vPath As Variant
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set wb = Excel.ActiveWorkbook
Set ws = Excel.ActiveSheet
vPath = Application.GetOpenFilename("all (Comma Delimited) (*.),*.", 1, "Select a file", , False)
Workbooks.OpenText Filename:=vPath, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, Comma:=True _
, FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), _
Array(3, xlTextFormat))
Columns.EntireColumn.AutoFit
Sheets(1).Move Before:=wb.Sheets(4)



'Sorterer informasjonen i den nye arkfanen som har blitt opprettet, så kopiere og lime inn informasjonen _
i det arket man egentlig vil ha informasjonen i (Ark Olfi)
Sheets(5).Select
   Columns("a:a").Select
   Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
       FieldInfo:=Array(Array(0, 1), Array(4, 1), Array(44, 1), Array(45, 1), Array(55, 1), _
       Array(58, 1), Array(70, 1), Array(77, 1)), TrailingMinusNumbers:=True
       Range("A1:h100").Select
   Selection.NumberFormat = "General"
   Range("a1:h66").Select
   Selection.Copy
   Sheets(1).Select
   Range("a1").Select
   ActiveSheet.Paste
   Range("a1").Select

'Sletter den nye Arkfanen som har blitt opprettet.
   Sheets(5).Select
   ActiveWindow.SelectedSheets.Delete
   Sheets("Plukk").Select
   Application.ScreenUpdating = True

 

Tusen takk til de som har bidratt så langt. :)

Men som sagt, dette fungerer men det er ikke løsningen jeg er ute etter.

 

 

Mvh

 

Torbjørn

Endret av Bigelk
Lenke til kommentar
  • 3 uker senere...

Hei.

 

Da var problemet løst.

 

'velger hvilket ark innformasjonen skal importeres til
Sheets(1).Select
ActiveSheet.Select
Dim IntPath$, project$, pickf As Object
'velger hvor innformasjonen skal hentes fra
IntPath = "//filserver/tope/tonn"
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: Exit Sub
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

Endret av Bigelk
Lenke til kommentar

Opprett en konto eller logg inn for å kommentere

Du må være et medlem for å kunne skrive en kommentar

Opprett konto

Det er enkelt å melde seg inn for å starte en ny konto!

Start en konto

Logg inn

Har du allerede en konto? Logg inn her.

Logg inn nå
×
×
  • Opprett ny...