Exportieren von Abfrageergebnissen in eine neue Excel-Datei mit .filedialog

Question

Ich habe eine geteilte Datenbank mit einem Formular, das gefilterte Ergebnisse aus einer Abfrage anzeigt. Ich möchte einfach die Ergebnisse in eine neue Excel-Anwendung/Arbeitsmappe exportieren. Ich kann nur Beispiele für den Export in eine vorhandene Datei finden, ich möchte eine leere Datei, damit der Benutzer sie speichern kann, wo sie wollen. Wie bekomme ich den Pfad und den Namen von der Eingabeaufforderung von filialialog und setze das auf eine Variable, damit ich es in die DoCmd.TransferSpreadsheet setzen kann? Das Ergebnis i jetzt bekommen ist „File-Dialog (MsoFileDialogSaveAs)“ als Dateiname ....

Private Sub btnToExcel_Click() 

    Dim fd As Office.FileDialog 

    Set fd = Application.FileDialog(msoFileDialogSaveAs) 

    With fd 

     .AllowMultiSelect = True   

     .Title = "Please select file to save" 

     If .Show = True Then 

     Else 

      MsgBox "You clicked Cancel." 

     End If 

    End With 

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Scale_Log", fd, True 

    End Sub 

Answer 1

Cobbled etwas anderes zusammen, das funktioniert. Kopieren Sie Elemente aus einem Listenfeld in eine neue Excel-Arbeitsmappe. Die Listbox zeigt meine Abfrageergebnisse an.

Private Sub btnExport_Click()

Dim myExApp As Excel.Application 'variable for Excel App 

    Dim myExSheet As Excel.Worksheet 'variable for Excel Sheet 

    Dim i As Long      'variable for ColumnCount 

    Dim j As Long      'variable for ListCount 

    Set myExApp = New Excel.Application 



    myExApp.Visible = True    'Sets Excel visible 

    myExApp.Workbooks.Add    'Add a new Workbook 

    Set myExSheet = myExApp.Workbooks(1).Worksheets(1) 



    For i = 1 To ltbFiltered.ColumnCount 'Counter for ColumnCount 

     ltbFiltered.BoundColumn = ltbFiltered.BoundColumn + 1 'Setting counter for BoundColumn 

     For j = 1 To ltbFiltered.ListCount 'Counter for ListCount 

      myExSheet.Cells(j, i) = ltbFiltered.ItemData(j - 1)  'Insert ItemData into Excel Worksheet 

     Next j 'Iterating through ListCount 

    Next i 'Iterating through ColumnCount 

    ltbFiltered.BoundColumn = 1 'Setting BoundColumn to original 1 



    Set myExSheet = Nothing 'Release Worksheet 

    Set myExApp = Nothing 'Release Excel Application 



    End Sub 

Answer 2

Hier eine Reihe von Funktionen, das ich verwende Tabellen nach Excel zu exportieren. Export_Data fordert zur Ermittlung auf, ob es sich um eine neue oder vorhandene Datei handelt, und verwendet entweder Get_File oder Get_Folder, um nach dem Pfad zu suchen. Es verwendet einige andere Dinge, die hier nicht enthalten sind - einschließlich einer Tabelle von Dingen, die exportiert werden sollen, die im Funktionsaufruf verwendet wird, und einer "Dump" -Routine, die die tatsächliche Kopie an die Arbeitsmappe ausführt. Wenn das Beispiel Ihre Frage beantwortet, gut - wenn Sie weitere Informationen benötigen, lassen Sie es mich wissen.

Public Function Export_data(Optional table As String = "export test") 

    'On Error GoTo NextTab 

    'clear excel 
    MsgBox ("Save and close all excel workbooks") 
    n = close_excel() 
    Set wb_app = CreateObject("Excel.Application") 
    wb_app.DisplayAlerts = False 
    Set wb_obj = wb_app.Workbooks.Add 
    wb_obj.Activate 

    opt = InputBox("existing template (E) or new file (input file name)") 
    If opt = "E" Then 
     FileName = Get_File() 
     Set wb_obj = wb_app.Workbooks.Open(FileName) 
     Else: 
     Path = Get_Folder() 
     FileName = Path & "\" & opt & ".xlsx" 
     Set wb_obj = wb_app.Workbooks.Add 
     wb_obj.Sheets(1).Name = "Index" 
     End If 
    wb_obj.Activate 

    'Get list of Exports to process 
    Set Exports = CurrentDb().OpenRecordset("select * from [" & table & "] order by worksheet") 

    'Process the exports 
    Do While Not Exports.EOF 
     ws_name = Exports.Fields("Worksheet") 
     Source = Exports.Fields("Source_data") 
     Set source_data = CurrentDb().OpenRecordset(Source) 
     'Set qdf = CurrentDb().QueryDefs(Source) 
     'If qdf.Parameters.Count > 0 Then 
     ' For Each prm In qdf.Parameters 
     '  prm.Value = Eval(prm.Name) 
     '  Next prm 
     ' End If 
     'Set source_data = qdf.OpenRecordset(dbOpenDynaset) 

     x = dump(source_data, ws_name, wb_obj) 
     source_data.Close 

     Exports.MoveNext 
     Loop 

    'add index 
    x = Index(wb_obj) 

    'save & close 
    ftype = Mid(FileName, InStr(FileName, ".")) 
    FileName = Left(FileName, InStr(FileName, ".") - 1) 
    wb_obj.SaveAs FileName & " " & Format(Now(), "yyyy-mm-dd") & ftype 
    wb_obj.Close 

    'final cleanup 
    wb_app.DisplayAlerts = True 
    wb_app.Quit 
    Set source_data = Nothing 
    Set Exports = Nothing 
    Set list = Nothing 
    Set db = Nothing 
    Set wb_obj = Nothing 
    Set wb_app = Nothing 
    n = close_excel() 
    MsgBox ("Exports Completed") 

    End Function 

    Public Function Get_File(Optional ftype = "xls") 

    Dim fd As Object 
    Const msoFileDialogFolderPicker = 4 
    Const msoFileDialogFilePicker = 3 
    Const msoFileDialogViewDetails = 2 

    'Create a FileDialog object as a File Picker dialog box. 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 
    fd.AllowMultiSelect = False 
    fd.ButtonName = "Select" 
    fd.InitialView = msoFileDialogViewDetails 
    fd.Title = "Select File" 
    fd.InitialFileName = "MyDocuments\" 
    fd.Filters.Clear 
    fd.Filters.Add "Files", "*." & ftype & "*" 

    'Show the dialog box and get the file name 
    If fd.Show = -1 Then 
     Get_File = fd.SelectedItems(1) 
     Else 
     Get_File = "" 
     End If 

    End Function 

    Public Function Get_Folder() 

    'Create a FileDialog object as a Folder Picker dialog box. 
    Const msoFileDialogFolderPicker = 4 
    Const msoFileDialogFilePicker = 3 
    Const msoFileDialogViewDetails = 2 

    Set fd = Application.FileDialog(msoFileDialogFolderPicker) 
    fd.AllowMultiSelect = False 
    fd.ButtonName = "Select" 
    fd.InitialView = msoFileDialogViewDetails 
    fd.Title = "Select Folder" 
    fd.InitialFileName = "MyDocuments\" 
    fd.Filters.Clear 

    'Show the dialog box and get the file name 
    If fd.Show = -1 Then 
     Get_Folder = fd.SelectedItems(1) 
     Else 
     Get_Folder = "MyDocuments\" 
     End If 

    Set fd = Nothing 
    End Function