Excel VBA Import from Access

[AndrewKent]

Hi folks,

I am having toruble with the code below. I have written a routine to extract data from Access if that data falls between two weeks. It works fine when I manually put in the two weeks I want (shown in the commented out query) however as soon as I try and link it to a variable it tells me it is having a type mismatch error.

Now, the StartWeek and EndWeek cells are both formatted to number, they contain formulas. The database field for WeekNo is set to Number.

Now the strange thing is if I change the WeekNo field in Access to text. this code does not bring back a type mismatch. Although that does mean I can't do any greater than or equal to queries.

Sub ActivityReportData()

'   =============================================================================================

'   =============================================================================================
    
    Dim VersionName As String
    Dim LastRow As Integer
    Dim ActiveRow As Integer
    Dim BancTelServer As String
    Dim DBName As String
    Dim DBLocation As String
    Dim FilePath As String
    Dim DBRecordSet As ADODB.Recordset
    Dim DBConnection As ADODB.Connection
    Dim ReferralID As String
    Dim Query As String
    Dim StartWeek As Integer
    Dim EndWeek As Integer

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set DBConnection = New ADODB.Connection
    VersionName = Worksheets("File Locations").Range("FL_VersionName").Value
    BancTelServer = Worksheets("File Locations").Range("FL_BancTel_Server").Value
    DBName = Worksheets("File Locations").Range("FL_SalesDatabase_File").Value
    DBLocation = Worksheets("File Locations").Range("FL_SalesDatabase_Location").Value
    FilePath = BancTelServer & DBLocation & DBName
    StartWeek = Worksheets("Date Matrix").Range("N19").Value
    EndWeek = Worksheets("Date Matrix").Range("N21").Value

    With Worksheets("Activity Report Extract")
        .Select
        .Range("B8:J" & Range("B65536").End(xlUp).Offset(2, 0).Row & "").Delete Shift:=xlUp
        .Range("B7:J7").ClearContents
        .Range("A1").Select
    End With

    With DBConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open FilePath
    End With
    
    Query = "SELECT tblData_ActivityReport.ActvityReport_EventType, tblData_ActivityReport.ActvityReport_ContractCode, tblData_Codes.Claimed_Referral_ID, tblData_ActivityReport.ActvityReport_WeekNo, tblData_ActivityReport.ActvityReport_SellerCode, tblData_ActivityReport.ActvityReport_IntroducerName, tblData_ActivityReport.ActvityReport_CustomerName, tblDefinition_ProductCode.ProductCode_Type, tblData_ActivityReport.[ActvityReport_FPD Credit] FROM (tblDefinition_ProductCode RIGHT JOIN tblData_ActivityReport ON tblDefinition_ProductCode.ActvityReport_ProductCode = tblData_ActivityReport.ActvityReport_ProductCode) LEFT JOIN tblData_Codes ON tblData_ActivityReport.ActvityReport_ContractCode = tblData_Codes.ActivityReport_ContractCode WHERE (((tblData_ActivityReport.ActvityReport_WeekNo)>='" & StartWeek & "' and (tblData_ActivityReport.ActvityReport_WeekNo)<='" & EndWeek & "'));"
'    Query = "SELECT tblData_ActivityReport.ActvityReport_EventType, tblData_ActivityReport.ActvityReport_ContractCode, tblData_Codes.Claimed_Referral_ID, tblData_ActivityReport.ActvityReport_WeekNo, tblData_ActivityReport.ActvityReport_SellerCode, tblData_ActivityReport.ActvityReport_IntroducerName, tblData_ActivityReport.ActvityReport_CustomerName, tblDefinition_ProductCode.ProductCode_Type, tblData_ActivityReport.[ActvityReport_FPD Credit] FROM (tblDefinition_ProductCode RIGHT JOIN tblData_ActivityReport ON tblDefinition_ProductCode.ActvityReport_ProductCode = tblData_ActivityReport.ActvityReport_ProductCode) LEFT JOIN tblData_Codes ON tblData_ActivityReport.ActvityReport_ContractCode = tblData_Codes.ActivityReport_ContractCode WHERE (((tblData_ActivityReport.ActvityReport_WeekNo)>=1 And (tblData_ActivityReport.ActvityReport_WeekNo)<=26));"
    Set DBRecordSet = New ADODB.Recordset
    DBRecordSet.CursorLocation = adUseServer
    DBRecordSet.Open Source:=Query, ActiveConnection:=DBConnection, CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText
    
    Worksheets("Activity Report Extract").Range("B7").CopyFromRecordset DBRecordSet
    
    DBRecordSet.Close
    DBConnection.Close
    Set DBRecordSet = Nothing
    Set DBConnection = Nothing
    
    With Worksheets("Activity Report Extract")
        .Select
        .Range("B7:J7").Copy
        .Range("B7:J" & Range("B65536").End(xlUp).Row & "").PasteSpecial xlPasteFormats
        .Range("A1").Select
    End With
    
End Sub

Many thanks,

Andy

 

[RoryA]

If your weeks are numbers, you should not put single quotes round them in the where clause. Change this bit:

tblData_ActivityReport.ActvityReport_WeekNo)>='" & StartWeek & "' and (tblData_ActivityReport.ActvityReport_WeekNo)<='" & EndWeek & "'));"

to this:

tblData_ActivityReport.ActvityReport_WeekNo)>=" & StartWeek & " and (tblData_ActivityReport.ActvityReport_WeekNo)<=" & EndWeek & "));"

 

[AndrewKent]

That's what I need! And you've solved a few other problems I've been having as well. It all makes sense now!

Thanks,

Andy

600 posts woot!