Importing from Access to excel

[sgaurav]

I have a tool that I have been using to import data from Access database and then I would make a graph of that. It used to import just fine but since the year has changed(Jan1st) it stopped importing.
I have pasted the code can you please provide some help.
this commandbutton2_click is actually the "import" button

Private Sub CommandButton2_Click()
'Declare variables
Dim Db As Database
Dim Rs As Recordset
Dim Ws As Object
Dim i As Integer
Dim Path As String

Dim MyDatabase As String
Dim DatabaseTable As String
With Sheets("PRRS Information")
MyDatabase = .Range("AccessName")
DatabaseTable = .Range("AccessTable")
End With

Set Ws = Sheets("QRY_Data_PRRS")

'This set of code will activate Sheet1 and clear any existing data
'After clearing the data it will select cell A1
Ws.Activate
Ws.Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Ws.Range("A1").Select

'Set the Database, and RecordSet This Table exists in the database
Set Db = Workspaces(0).OpenDatabase(MyDatabase, ReadOnly:=True)

'This will set the RecordSet to all records in the Customers table
Set Rs = Db.OpenRecordset(DatabaseTable)

'This loop will collect the field names and place them in the first
'row starting at "A1"
For i = 0 To Rs.Fields.Count - 1
Ws.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next i

'The next line simply formats the headers to bold font
Ws.Range(Ws.Cells(1, 1), Ws.Cells(1, Rs.Fields.Count)).Font.Bold = True

'The next line will get the data from the recordset and copy it
'into the Worksheet (Sheet1).
Ws.Range("A2").CopyFromRecordset Rs

'This next code set will just select the data region and
'auto-fit the columns
Sheets("QRY_Data_PRRS").Range("A1").Select
Selection.CurrentRegion.Select
Selection.Columns.AutoFit
Sheets("QRY_Data_PRRS").Range("A1").Select

Rs.Close
Db.Close
End Sub

Private Sub PRRSDataButton_Click()

Application.ScreenUpdating = False

Sheets("PRRS Information").Select
YearNum = ActiveSheet.Cells(8, 4)
MonthNum = ActiveSheet.Cells(7, 4)
WeekNum = ActiveSheet.Cells(6, 4)

Count = 2
Sheets("QRY_Data_PRRS").Select
Do While ActiveSheet.Cells(Count, 1) <> ""
If ActiveSheet.Cells(Count, 12) = YearNum Then
'For Year
YNumCases = YNumCases + 1
YNumTests = YNumTests + ActiveSheet.Cells(Count, 5)
YNumPositive = YNumPositve + ActiveSheet.Cells(Count, 6)
YNumSuspect = YNumSyspect + ActiveSheet.Cells(Count, 7)
YNumInconsistent = YNumInconsistent + ActiveSheet.Cells(Count, 8)
If ActiveSheet.Cells(Count, 11) = MonthNum Then
'For Month
MNumCases = MNumCases + 1
MNumTests = MNumTests + ActiveSheet.Cells(Count, 5)
MNumPositive = MNumPositve + ActiveSheet.Cells(Count, 6)
MNumSuspect = MNumSyspect + ActiveSheet.Cells(Count, 7)
MNumInconsistent = MNumInconsistent + ActiveSheet.Cells(Count, 8)
End If
If ActiveSheet.Cells(Count, 10) = WeekNum Then
'For Week
WNumCases = WNumCases + 1
WNumTests = WNumTests + ActiveSheet.Cells(Count, 5)
WNumPositive = WNumPositve + ActiveSheet.Cells(Count, 6)
WNumSuspect = WNumSyspect + ActiveSheet.Cells(Count, 7)
WNumInconsistent = WNumInconsistent + ActiveSheet.Cells(Count, 8)
End If
End If
Count = Count + 1
Loop

Sheets("PRRS Information").Select
'Paste Results
'Week
ActiveSheet.Cells(12, 6).Value = WNumCases
ActiveSheet.Cells(14, 3).Value = WNumTests
ActiveSheet.Cells(14, 4).Value = WNumPositive
ActiveSheet.Cells(14, 5).Value = WNumSuspect
ActiveSheet.Cells(14, 6).Value = WNumInconsistant
'Month
ActiveSheet.Cells(18, 6).Value = MNumCases
ActiveSheet.Cells(20, 3).Value = MNumTests
ActiveSheet.Cells(20, 4).Value = MNumPositive
ActiveSheet.Cells(20, 5).Value = MNumSuspect
ActiveSheet.Cells(20, 6).Value = MNumInconsistant
'Year
ActiveSheet.Cells(24, 6).Value = YNumCases
ActiveSheet.Cells(26, 3).Value = YNumTests
ActiveSheet.Cells(26, 4).Value = YNumPositive
ActiveSheet.Cells(26, 5).Value = YNumSuspect
ActiveSheet.Cells(26, 6).Value = YNumInconsistant

End Sub




Sub graphInformation()
Application.ScreenUpdating = False

Dim TempArray(52, 5)

Sheets("PRRS Information").Select
For i = 4 To 54
If ActiveSheet.Cells(i - 1, 18) = 1 Then
ActiveSheet.Cells(i, 18).FormulaR1C1 = 53
ActiveSheet.Cells(i, 19).FormulaR1C1 = 2003
Else
ActiveSheet.Cells(i, 18).FormulaR1C1 = Val(ActiveSheet.Cells(i - 1, 18)) - 1
ActiveSheet.Cells(i, 19).FormulaR1C1 = ActiveSheet.Cells(i - 1, 19)
End If
Next i
For i = 3 To 54
TempArray(i - 2, 0) = ActiveSheet.Cells(i, 18) & "/" & ActiveSheet.Cells(i, 19)
Next i

Sheets("QRY_Data_PRRS").Select
Count = 2
Do While ActiveSheet.Cells(Count, 1) <> ""
TempDate = ActiveSheet.Cells(Count, 10) & "/" & ActiveSheet.Cells(Count, 12)
For i = 1 To 52
If TempArray(i, 0) = TempDate Then
TempArray(i, 1) = TempArray(i, 1) + ActiveSheet.Cells(Count, 6) + ActiveSheet.Cells(Count, 7) '# Pos + # Suspect + Previous Counts
TempArray(i, 2) = TempArray(i, 2) + ActiveSheet.Cells(Count, 8) 'Incostintent 'Previous Counts + # Inconsistant
TempArray(i, 3) = TempArray(i, 3) + ActiveSheet.Cells(Count, 5) 'PRRS count 'Previous Counts + # PRRS
TempArray(i, 4) = TempArray(i, 4) + ActiveSheet.Cells(Count, 6) 'Positive 'Previous Counts + # Positive
TempArray(i, 5) = TempArray(i, 5) + ActiveSheet.Cells(Count, 7) 'Suspect
i = 53
End If
Next i
Count = Count + 1
Loop

Sheets("PRRS Information").Select
For i = 3 To 54
If TempArray(i - 2, 1) = "" Then
'ActiveSheet.Cells(i, 20).Value = 0
'ActiveSheet.Cells(i, 21).Value = 0
'ActiveSheet.Cells(i, 22).Value = 0
'ActiveSheet.Cells(i, 23).Value = 0
'ActiveSheet.Cells(i, 24).Value = 0
'ActiveSheet.Cells(i, 25).Value = 0
'ActiveSheet.Cells(i, 26).Value = 0
ActiveSheet.Cells(i, 20).Value = 0
ActiveSheet.Cells(i, 21).Value = 0
ActiveSheet.Cells(i, 22).Value = 0
ActiveSheet.Cells(i, 23).Value = 0
ActiveSheet.Cells(i, 16).Value = 0
ActiveSheet.Cells(i, 17).Value = 0

Else
ActiveSheet.Cells(i, 20).Value = TempArray(i - 2, 1)
ActiveSheet.Cells(i, 21).Value = TempArray(i - 2, 2)
ActiveSheet.Cells(i, 22).Value = TempArray(i - 2, 3)
ActiveSheet.Cells(i, 23).Value = (TempArray(i - 2, 3) - TempArray(i - 2, 4)) / TempArray(i - 2, 3)
ActiveSheet.Cells(i, 16).Value = TempArray(i - 2, 4)
ActiveSheet.Cells(i, 17).Value = TempArray(i - 2, 5)
End If
Next i
End Sub