VB6 exporting to Excel

[kimtp]

Have an app where data is exported from Access to Excel via VB6. The transfer runs smoothly. However, if the user does not want to complete the transaction, I got problems.

Dim objExcelApp As Excel.Application
Dim xlsExcelSheet As Excel.Worksheet
objExcelApp.Workbooks.Add 'add the worksheet
Set objExcelApp = New Excel.Application
objExcelApp.Visible = True 'Did this as a reminder to save the worksheet. Else the program hangs at the end of the sub.

Next I open the Access connection then plant the info into Excel

If Dir$(App.Path & "book1.xls") <> vbNullString Then Kill App.Path & "book1.xls"
conn.Execute "SELECT * INTO [Excel 8.0; Database=" & App.Path & "book1.xls].[Sheet1]" & _
" FROM Members", iNum 'inum is to pick # of records transferred

After looping through the records, save the file and quit the application:

objExcelApp.DefaultFilePath = App.Path
objExcelApp.Application.SaveWorkspace (App.Path & "\book1")
objExcelApp.Quit

At the point of saving the file as book1.xls, if the user clicks cancel instead of save, I get an error msg "Method 'SaveWorkspace' of object_Application failed". Error number 1004. I work around this with a boolean. If any error occurs, boolean is false, no records transferred and an msgbox tells the user.

If Err.Number = 1004 Then 'user cancelled operation or any error
objExcelApp.Visible = False
objExcelApp.Quit 'This causes a msgbox 'Do you want to save ....'
bFileSaved = False
Exit Sub
End If

This seems to be a clumsy and obviously wrong way to accomplish the transfer thing. Is there a way to do it silently with excel not being visible and at the same time if the user clicks cancel there is no save file msg. Also, how to close the application at the end of the sub?

Thanks.

Kim

 

[rsinj]

check if setting objExcelApp.DisplayAlerts = False prevents the error from popping up.

 

[rsinj]

Also, how to close the application at the end of the sub?"

The VB sub? You mean like "End"?

 

[kimtp]

Thanks for the post. My sub is a hybrid from thread222-744183 using code from pmrankine and Swi and it works as long as the export is saved in Excel. The trouble comes when the data is not saved. I am using the displayalerts = false. I have included my sub:

Public Sub ExportDataExcel(ByRef sSaveFile As String, ByRef iNum As Integer, ByRef bFileSaved As Boolean)
    On Error GoTo ErrHandle
    Dim fso As New FileSystemObject
    Dim bFileExists As Boolean
    Dim sFileName As String
    Dim cn As New ADODB.Connection
    Dim objExcelApp As Excel.Application
    Dim xlsExcelSheet As Excel.Worksheet
    Dim col As Integer
    Dim Row As Integer

    sFileName = App.Path & "\" & sSaveFile
    
    'check to see sSaveFile exists, if so delete it
    vbFileExists sFileName, bFileExists
     If bFileExists Then
        fso.DeleteFile sFileName
    End If
   
    ' Create the Excel application.
    Set objExcelApp = New Excel.Application
    objExcelApp.Visible = False

    ' Add the Excel spreadsheet.
    objExcelApp.Workbooks.Add
    ' Check for later versions.
    If Val(objExcelApp.Application.Version) >= 8 Then
        Set xlsExcelSheet = objExcelApp.Worksheets(1)
    Else
        Set xlsExcelSheet = objExcelApp
    End If

    ' Open the Access database.
    Dim conn As ADODB.Connection
    Set conn = New ADODB.Connection
    Dim rs as New ADODB.Recordset
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\temp.mdb" & _
         ";Persist Security Info=False"
    conn.Open

    ' Select the data.
    Set rs = conn.Execute("SELECT * FROM Members", , adCmdText)
    sSql = "SELECT * FROM Members"
    ' Make the column headers.
    For col = 0 To rs.Fields.Count - 1
        xlsExcelSheet.Cells(1, col + 1) = rs.Fields(col).Name
    Next col
    
    If Dir(App.Path & "\" & sSaveFile) <> vbNullString Then Kill App.Path & "\" & sSaveFile
    conn.Execute "SELECT * INTO [Excel 8.0; Database=" & (App.Path & "\") & sSaveFile)"].[Sheet1]" & _
                " FROM Members", iNum

    ' Get data from the database and insert it into the spreadsheet.
    Row = 2
    Do While Not rs.EOF
        For col = 0 To rs.Fields.Count - 1
            xlsExcelSheet.Cells(Row, col + 1) = rs.Fields(col).Value
        Next col 
        Row = Row + 1
        rs.MoveNext
    Loop
    rs.Close
    conn.Close
    Set conn = Nothing
    cn.Close
    objExcelApp.DisplayAlerts = False
    objExcelApp.DefaultFilePath = App.Path
    objExcelApp.Application.SaveWorkspace (App.Path & "\") & sSaveFile)  [COLOR=green]'[/color][COLOR=red]If user cancels, get an error + Excel sometimes hangs[/color]
    objExcelApp.Quit
    bFileSaved = True

ExportDataExcel_Exit:
    Set xlsExcelSheet = Nothing
    Set objExcelApp = Nothing
    Exit Sub
ErrHandle:
    objExcelApp.Quit [COLOR=green]'[/color][COLOR=red]not effective on error[/color]
    Set xlsExcelSheet = Nothing
    Set objExcelApp = Nothing
    bFileSaved = False
    Exit Sub
End Sub

Also, since using the variable sSaveFile, I get the error msg 'can not access file'. I use an inputbox to get the users name for the exported Excel file. However, whenever the 'File SaveAs' appears, book1.xls is always there. Is there someway to place the users name into the saveas box?

Thanks for the help.

Kim

 

[kimtp]

This works:

objExcelApp.ActiveWorkbook.SaveAs (sFilename)