Import External Data - jak wskazać plik? (VBA)

0

Postaram się streszczać. Potrzebuję macra, które będzie importować pliki *.csv do akusza excel według określonego schemtu. Nagrałem takie. Nagrywając wskazałem konktetny plik więc nagrane macro importuje dane tylko z niego. W jaki sposób dodać na początku popup który umożliwi mi wskazanie pliku z danymi?

W tym momencie macro wygląda tak:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 2011-07-06 by Michał
'

'
        With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;G:\Progam Files\Data\al\June.csv", Destination:=Range("A1"))
        .Name = "June"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 5
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=-21
End Sub
0

Może w ten sposób:

file_csv = Application.GetOpenFilename (....)

if file_csv <> False then
 Macro1 file_csv 
end if

Sub Macro1(strConnection as String)
'
' Macro1 Macro
' Macro recorded 2011-07-06 by Michał
'

' zamist G:\Progam Files\Data\al\June.csv podstawiasz zmienną

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strConnection, Destination:=Range("A1"))
        .Name = "June"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 852
        .TextFileStartRow = 5
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=-21
End Sub
0

Dziękuję za odpowiedź. Rozumiem twój pomysł ale nie potrafię go zastosować.

Mam coś takiego:

Sub Macro1()

file_csv = Application.GetOpenFilename

If file_csv <> False Then
Macro1 file_csv
End If
'
' Macro1 Macro
' Macro recorded 2011-07-06 by Michał
'

' zamist G:\Progam Files\Data\al\June.csv podstawiasz zmienną

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;file_csv" & strConnection, Destination:=Range("A1"))
    .Name = "June"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 852
    .TextFileStartRow = 5
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-21

End Sub

i dostaję błąd na Macro1 file_csv o treści : Wrong number of argumnents or invalid propety assignment.

Czy mógłbyś coś na to poradzić?

0
Sub ProceduraStartowa()
Dim file_csv  as Variant

file_csv = Application.GetOpenFilename

 if file_csv <> False then
  Call ProceduraWczytująca(file_csv) 
 end if
End Sub

Sub ProceduraWczytująca(ByVal strConnection as String)

        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strConnection, Destination:=Range("A1"))
            .Name = Right$(strConnection, Len(strConnection) - InStrRev(strConnection, "\"))  
           '' tu przekopiuj pozostałe elementy z twojego Makro1
       End With
End Sub

Teraz skopiuj to co powyżej do swojego ThisWorkbook czy tam Module1, uzupełnij resztę kodu z Makro1.
Ustaw kursor myszki na linijce file_csv = Application.GetOpenFilename , wciskając F8 prześledzisz krok po kroku co się dzieje.

0

Teraz przechodzi przez tę linijkę ale wywala sie w innej. Całość:

Sub ProceduraStartowa()
Dim file_csv As Variant

file_csv = Application.GetOpenFilename("Text Files (*.txt), .txt, Add-in Files (.xla), *.xla", 2, _
"Open My Files", , True)

If file_csv <> False Then
Call ProceduraWczytująca(file_csv)
' tutaj się wywala, zaznacza file_csv, komunikat ByRef Argument type mismatch
End If
End Sub

Sub ProceduraWczytująca(strConnection As String)

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strConnection, Destination:=Range("A1"))
' tu wkleiłem reszte
End With
ActiveWindow.SmallScroll Down:=-21

   End With

End Sub

0

Wyciąłem trochę z tego i zaczęło działać!

Wygląda to tak:

Dziękuję za pomoc! Zaoszczędziłeś mi sporo czasu.

Po

Dziękuję za pomoc! Zaoszczędziłeś mi sporo czasu.

Pozdrawiam

0

cześć, możesz napisać co zmieniłęś że kod działał ;)

1 użytkowników online, w tym zalogowanych: 0, gości: 1