Valkie (valkyri) wrote in ms_access,
Valkie
valkyri
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
rs.MoveFirst

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

.Columns("B:B").ColumnWidth = 7
.Rows("1:1").Select
.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
rs.MoveNext
Loop

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

ErrEnd:
Exit Function

ErrControl:
ErrorLog
MsgBox Err.Description
Resume ErrEnd

End Function



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

    Error

    default userpic
  • 6 comments