[X]My Assistant

[karen_nicholson]

This Access code is executing with no errors, but the data is not being populated in the Excel workbook. What am I missing?

CODE

Dim Filename As String
Static Path As String
Dim R As Integer
Dim C As Integer
Dim i As Integer
Dim DateColumnCount As Integer
Dim ans As Double
Dim Warehouses As String
Dim Hierarchy As String
Dim MinDate As String
Dim MaxDate As String
Dim Adjust As Boolean
Dim SQLStatement As String
Dim strSQL As String
Dim DBConn As ADODB.Connection
Dim Cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim XLSFile As Excel.Application
Dim LeaveOpen As Boolean

Path = Nz(DFirst("ParameterValue", "tbl_ForecastWH_SalesDataExportDefaults", "Parameter='SalesExportPath'"), "")
If Dir(Left(Path, InStrRev(Path, "\")), vbDirectory) <> "" Then
    Path = Left(Path, InStrRev(Path, "\"))
Else
    Path = ""
End If

LeaveOpen = Forms("frmSalesDataOutput").checkLeaveOpen

Const Q = """"

On Error GoTo ErrorCondition

    'Get the parameters for the query
    Warehouses = ""
    For i = 0 To Forms("frmSalesDataOutput").listWarehouses.listcount - 1
        If Warehouses <> "" Then Warehouses = Warehouses & ","
        Warehouses = Warehouses & Forms("frmSalesDataOutput").listWarehouses.ItemData(i)
    Next
    
    If Warehouses = "" Then
        MsgBox "No warehouses were selected.", vbCritical, "Invalid Parameter"
        GoTo SaveData_Exit
    End If
    
    Hierarchy = ""
    For i = 0 To Forms("frmSalesDataOutput").listHierachy.listcount - 1
        If Hierarchy <> "" Then Hierarchy = Hierarchy & ","
        Hierarchy = Hierarchy & Forms("frmSalesDataOutput").listHierachy.ItemData(i)
    Next
    
    If Hierarchy = "" Then
        MsgBox "No field were selected in the hierarchy.", vbCritical, "Invalid Parameter"
        GoTo SaveData_Exit
    End If
    
    MinDate = Forms("frmSalesDataOutput").txtStartDate
    If CDate(MinDate) > Now Then
        MsgBox "The start date is greater than the current date.", vbCritical, "Invalid Parameter"
        GoTo SaveData_Exit
    End If
    
    MaxDate = Forms("frmSalesDataOutput").txtEndDate
    If CDate(MaxDate) < MinDate Then
        MsgBox "The start date after the end date.", vbCritical, "Invalid Parameter"
        GoTo SaveData_Exit
    End If
    If CDate(MaxDate) > Now Then
        ans = MsgBox("WARNING! The end date selected is greater than the current date.  Insufficent data will be included in the current month's sales data!  Are you sure you wish to continue?", vbExclamation + vbYesNo, "WARNING!")
        If ans <> vbYes Then GoTo SaveData_Exit
    End If
    
'    Adjust = Forms("frmSalesDataOutput").checkAdjust.Value

    
    'Get Export Sales Data Filename from user
    With Me!FileDialogControl
        .CancelError = True
        .Filename = "SalesHistory.XLS"
        .InitDir = Path
        .DialogTitle = "Save Sales History Data File"
        .Filter = "xls (*.xls)|*.xls|All Files (*.*)|*.*"
        '.Flags = cdlOFNExplorer + cdlOFNOverwritePrompt + cdlOFNPathMustExist
        .ShowSave
         Filename = .Filename
         Path = .InitDir
    End With
    
    If Filename = "" Then
        MsgBox "Data file creation canceled.", vbExclamation, "Canceled"
        GoTo SaveData_Exit
    End If
        
    'Clear old file
    On Error Resume Next
    Kill Filename
    If err.Number <> 0 And err.Number <> 53 Then 'check for error (ignore if file not found)
        GoTo ErrorCondition
    End If
    
    Screen.MousePointer = 11 'busy
    Dim XLSFileNew As Excel.Application
    Dim XLSQueryTable As Excel.QueryTable
    Dim SQLCommandString As String
    
    SQLCommandString = "EXEC sp_ForecastWH_SalesHistory @StartDate='" & MinDate & "', @EndDate='" & MaxDate & "', @WarehouseList='" & Warehouses & "', @HierarchyList='" & Hierarchy & "'"
    'strSQL = "EXEC sp_ForecastWH_SalesHistory  '01/01/07','10/31/19', '01,CA,WS','Total,Warehouse,Item';"
    Set XLSFileNew = New Excel.Application
    XLSFileNew.Workbooks.Add (1)
    XLSFileNew.Visible = LeaveOpen
    If LeaveOpen Then AppActivate XLSFileNew.Caption
    XLSFileNew.Worksheets(0).Activate
    XLSFileNew.ActiveSheet.Range("A1").Select

'==>Data Not Populating
    
    Set XLSQueryTable = XLSFileNew.ActiveSheet.QueryTables.Add("ODBC;DRIVER=SQL Server;SERVER=" & CurrentProject.Connection.Properties("Data Source") & ";Trusted_Connection=Yes;APP=2007 Microsoft Office system;DATABASE=" & CurrentProject.Connection.Properties("Initial Catalog"), XLSFileNew.ActiveSheet.Range("A1"), SQLCommandString)
    XLSQueryTable.RefreshStyle = XlCellInsertionMode.xlInsertEntireRows
    XLSQueryTable.Refresh (False)

    XLSQueryTable.Delete
    XLSFileNew.ActiveWorkbook.Connections(1).Delete
    
    XLSFileNew.ActiveWorkbook.Worksheets(1).Name = Format(MaxDate, "mmm-yyyy")
    XLSFileNew.ActiveWorkbook.SaveAs Filename, xlAddIn
    If Not LeaveOpen Then
        XLSFileNew.ActiveWorkbook.Close
        XLSFileNew.Quit
    End If
    Set XLSFileNew = Nothing
    
    RunSQL "delete from tbl_ForecastWH_SalesDataExportDefaults where Parameter='checkLeaveOpen';insert into tbl_ForecastWH_SalesDataExportDefaults values ('checkLeaveOpen','" & LeaveOpen & "')"
    RunSQL "delete from tbl_ForecastWH_SalesDataExportDefaults where Parameter='SalesExportPath';insert into tbl_ForecastWH_SalesDataExportDefaults values ('SalesExportPath','" & Filename & "')"
    
    
  
    Screen.MousePointer = 0 'default
    If Not LeaveOpen Then MsgBox "The Sales History file has been created.", vbOKOnly, "Success"

    
SaveData_Exit:

    Screen.MousePointer = 0 'default
    On Error GoTo 0
    DoCmd.Close acForm, "FileDialog"
    
    Exit Sub

ErrorCondition:

    Screen.MousePointer = 0 'default
    If err.Number = 32755 Then
        MsgBox "Data file creation canceled.", vbExclamation, "Canceled"
    Else
        MsgBox "Export file creation failed.  Error: " & err.DESCRIPTION, vbCritical, "Error"
    End If
    DoCmd.Close acForm, "FileDialog"

End Sub

[Debaser]

You wouldn't see any errors due to your On Error Resume Next statement. There certainly are some though, such as referring to Worksheets(0) since the indexing starts at 1.