Excel partially visiable

[china99boy]

Hey guys, I have the below code that exports data to excel. Works wonderful, except when the Excel file opens, only the top portion of excel is visable. I would then have to save the excel file, then close both excel and access. Then once I reopen the excel file it is now visible. I would like the file to open over all other application including my Access application. Is there any way to force the excel file to open fully? Is there something I am missing. It seems to work the first time, but if I re-run the export the problem continues. Thanks

Private Sub cmdGetReport_Click()
On Error GoTo Err_Handler

MsgBox ExportRequest, vbInformation, "Finished"
DoCmd.Close acForm, "frmMonthEndRpt"
Application.FollowHyperlink "R:\Call Center\Call Center Departments\Support\Daily Reports\Loan Statistics & Tracking\AOOutput.xls"

exit_Here:
   Exit Sub
Err_Handler:
   MsgBox Err.Description, vbCritical, "Error"
   Resume exit_Here
End Sub

Public Function ExportRequest() As String
         
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   
   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
   
   Dim dbs As DAO.Database
   Dim rst As DAO.Recordset
   Dim qd As DAO.QueryDef ' Added 10/06/07
   Dim sSql As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
   Dim strMacroName As String
   Dim strFileName As String

   strMacroName = "DeleteBlank"
   strFileName = "R:\Call Center\Call Center Departments\Support\Daily Reports\Loan Statistics & Tracking\AOOutput.xls"
     
   Const cTabOne As Byte = 1
   Const cStartRow As Byte = 4
   Const cStartColumn As Byte = 1
   
   DoCmd.Hourglass True
   
   ' set to break on all errors
   Application.SetOption "Error Trapping", 0
   
   ' start with a clean file built from the template file
   'sTemplate = CurrentProject.Path & \Call Center\Call Center Departments\Support\Daily Reports\Loan Statistics & Tracking\AOTemplate.xls"
   sTemplate = "R:\Call Center\Call Center Departments\Support\Daily Reports\Loan Statistics & Tracking\AOTemplate.xls"
   sOutput = "R:\Call Center\Call Center Departments\Support\Daily Reports\Loan Statistics & Tracking\AOOutput.xls"
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
   
   
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabOne)
         
   sSql = "select * from qryAOSummary"
   Set dbs = CurrentDb
   
   Set qd = dbs.QueryDefs("qryAOSummary")
   
   qd.Parameters![txtStartDate] = [Forms]![frmMonthEndRpt]![txtStartDate]
   qd.Parameters![txtEndDate] = [Forms]![frmMonthEndRpt]![txtEndDate]
   
   Set rst = qd.OpenRecordset
   If Not rst.BOF Then rst.MoveFirst
   
   ' For this template, the data must be placed on the 4th row, third column.
   ' (these values are set to constants for easy future modifications)
   iCol = cStartColumn
   iRow = cStartRow


   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
      Me.lblMsg.Caption = "Exporting record #" & lRecords & " to AoOutput.xls"
      Me.Repaint
      
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
         
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
         End If
         
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
      
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
   
    ExportRequest = "Total of " & lRecords & " rows processed."
   Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
   
'Inserts Month,Year format based on entry in start date field.
wks.Range("A2").Value = [Forms]![frmMonthEndRpt]![txtStartDate]

'The Application.Run will run the Macro(s) that you saved in your spreadsheet
wks.Application.Run "'" & strFileName & "'!" & strMacroName
      
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
    
End Function

 

[zazi69]

Hi,

I am using the same code and have the same problem. Did you find a fix to the problem. Besides, I need to "concatenate" multiple fields in one field on a row e.g. instead of having:

Column1 Column2 Column3 Column4
Order 1: Extenral Hard Disk 500GB 5

But to have instead:

Column1 Column2
Order 1:Extenral Hard Disk, 500GB 5

Thanks,