Export Access Query to Excel 1

[cneill]

Hi

How do I use the
DoCmd.TransferSpreadsheet acExport Query
then open the save as box to specify where to save the file.

I have found the code to open the Save as box, but I don't know how to connect the export to the save as box?

can anyone help please

 

[PHV]

I've already gave you the FileDialog code, so where is your problem now ?

 

[cneill]

hI phv,

Sorry I have not made myself clear

1.) The FileDialog Code allows me to specify the file to import - This is great so thankyou
2.) Once imported this file is used in a query, this query now needs to be exported, so how do I specify this query then choose where I want it to be exported too?
I have tried this
Export File Code
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Please Enter the name you wish to call the file and select the destination Folder"
.Filters.Clear
.Filters.Add "Excel files", "*.XLS"
.Filters.Add "All Files", "*.*"
.InitialFileName = "C:\Personnel\"
If .Show = True Then
For Each varFile In .SelectedItems
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QryMatchPostCodeToLOSA"
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With

But this does not work
Any Ideas?

 

[SkipVought]

Once imported this file is used in a query, this query now needs to be exported,

In what system/application will your query be executed?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[cneill]

Hi Skip

I import from excel to Access, which I can do, then i need to export the query (from Access) to Excel, but I what to be able to let the user decide where they what to save the file.

Thanks

CNEILL

 

[SkipVought]

Why not have the Excel user execute the query IN HIS WORKBOOK whenever he chooses?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[sparkbyte]

Is this something like what you are looking for??

Private Sub btnExporttoExcel_Click()
On Error GoTo Err_Handler

'------------------------------------------------------
'------------------------------------------------------
' Export New Table to Excel
'------------------------------------------------------
'------------------------------------------------------
Dim strFileName As String
Dim strDateMin As String
Dim strDateMax As String
Dim strUPSpriority As Integer

strDateMin = Format(DLookup("Min([TrackingDate])", "tblTrackingParse"), "mmddyy")
strDateMax = Format(DLookup("Max([TrackingDate])", "tblTrackingParse"), "mmddyy")

strUPSpriority = InputBox("Enter the UPS Shipping Priority Number", "UPS Shipping Priority", "1")

strFileName = InputBox("Enter the Excel Spreadsheet File Name", "Enter File Name", "Initiated " & _
                strDateMin & " to " & strDateMax)
   
   
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim exAppWs As Worksheet
Dim rng As Excel.Range

Set cmd = New ADODB.Command

With cmd
    .ActiveConnection = CurrentProject.Connection
    .CommandType = adCmdText
    .CommandText = "SELECT UPPER(BoxNumber), UPPER(FileNumber), TrackingDate " & _
                    "FROM dbo.View_ParsedTrackingTableWithFileNumberPrefixDescription " & _
                    "WHERE (FileNumber <> '.BOX.END.') " & _
                    "AND (BoxNumber NOT LIKE 'NBC%') " & _
                    "AND (Len(FileNumPrefix) = 1)" & _
                    "AND (LEN(BoxNumber) < '30') AND (BoxNumberPrefix LIKE '1Z') " & _
                    "AND BoxNumberShipping LIKE '%" & strUPSpriority & "%'"
End With

Set rst = cmd.Execute    ' now we have a recordset returned

If rst.BOF And rst.EOF Then
  MsgBox "Nothing to export !"
  Exit Sub
End If

Dim exCellApp As Excel.Application
Dim iCols As Integer
Set exCellApp = CreateObject("Excel.Application")
exCellApp.Visible = True
exCellApp.Workbooks.Add
exCellApp.AutoRecover.Enabled = False
exCellApp.Assistant.On = False


'------------------------------------------------------
'------------------------------------------------------
' Set Column Headings
'------------------------------------------------------
'------------------------------------------------------
exCellApp.Worksheets(1).Cells(1, 1).Value = "BoxNumber"
exCellApp.Worksheets(1).Cells(1, 2).Value = "FileNumber"
exCellApp.Worksheets(1).Cells(1, 3).Value = "TrackingDate"

'------------------------------------------------------
'------------------------------------------------------
' Populate the Spreadsheet
'------------------------------------------------------
'------------------------------------------------------

For iCols = 0 To rst.Fields.Count - 1
    exCellApp.Worksheets(1).Cells(2, iCols + 1).Value = rst.Fields(iCols).Name
Next

exCellApp.Worksheets(1).Range("a2").CopyFromRecordset rst

exCellApp.Columns("C:C").Select
exCellApp.Selection.NumberFormat = "[$-409]d-mmm-yyyy;@"
exCellApp.Cells.Select
exCellApp.Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
exCellApp.Cells.EntireColumn.AutoFit
exCellApp.Range("A1").Select

'Debug.Print _
'               "C:\" & Year(Date) & "\" & strFileName & ".XLS"

exCellApp.ActiveWorkbook.SaveAs Filename:= _
                "C:\" & Year(Date) & "\" & strFileName & ".XLS", _
                FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
                CreateBackup:=False

'exCellApp.Workbooks.Close

exCellApp.Quit


rst.Close

endit:
Exit Sub

Err_Handler:
 If StandardErrors(Err) = False Then
    BeepWhirl
    MsgBox Err & ": " & Err.Description
 End If
Resume endit

End Sub

Thanks

John Fuhrman

 

[SkipVought]

If the user is going to decide, then what part do you have? It's their rodeo,or did you have something else in mind?

I set up queries for many of my users, that imports data into a worksheet and can be refreshed at any time. Nothing at all needed in Access

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}