Valkie (valkyri) wrote in ms_access,

A strange thing...

I have a dozen or so procedures that take Access data and save it to excel. They worked before, and they have stopped working. This in itself leads me to believe that it's a system issue. I still need a way to fix it though, or an explanation of why this is happening all of a sudden.

What happens is that the command button is pressed which kicks off the event, the process runs as it is supposed to, it produces the "Save as" dialog box with defaults, the user can choose to save it where they want, choose to change the name if they want, then when they press "Save" everything appears fine - except no saved file ever results. The file is created new each time from data, I am not opening an existing sheet. It will not save though. Bizzare.

Function ExcelExport()
Dim xlobject As Object, xlsheet As Object
Dim cn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sSql As String, sSqlIO As String

On Error GoTo ErrControl

Set cn = CurrentProject.Connection

sSql = {The SQL statement}

rs.Open sSql, cn, adOpenDynamic, adLockOptimistic

Set xlobject = CreateObject("excel.sheet.8")
Set xlsheet = xlobject.Application.ActiveWorkbook.Sheets("sheet1")
With xlsheet

.Columns("B:B").ColumnWidth = 7
.Rows("1:1").RowHeight = 25
.Range("A1").Value = "Outstanding Purchases for " & rs("IO")

.Range("B3").Value = "UCN"
.Range("C3").Value = "Line ID"
.Range("D3").Value = "Description"
.Range("E3").Value = "GL"
.Range("F3").Value = "Fund"
.Range("G3").Value = "Amount"

End With
i = 4
tmpTotal = 0
Do While Not rs.EOF

With xlsheet

.Range("B" & i).Value = rs("UCN")
.Range("C" & i).Value = rs("Line_ID")
.Range("D" & i).Value = rs("Description")
.Range("E" & i).Value = rs("GL")
.Range("F" & i).Value = rs("Fund")
.Range("G" & i).Value = rs("Amount")
.Range("G" & i).NumberFormat = "$#,##0.##"

End With
i = i + 1

xlsheet.Application.GetSaveAsFileName InitialFilename:="Q:\Documents\OustandingPurchasesIO.xls", FileFilter:="Microsoft Excel Files (*.xls), *.xls"
Set xlobject = Nothing

Exit Function

MsgBox Err.Description
Resume ErrEnd

End Function

Eternal thanks and all that... :-)
  • Post a new comment


    default userpic
    When you submit the form an invisible reCAPTCHA check will be performed.
    You must follow the Privacy Policy and Google Terms of use.