Programming is not really my thing so I apologise for not really understanding some of the code I have pasted below. But I think I’m very close to getting this right and I just need some help to iron out a bug or two.
The task is (1) output an Access query to Excel (2) overwrite that file if it already exists (3) apply specific formatting to the header row and the other rows in Excel.
I have cobbled the code together from two sources. The beginning and end are adapted from code on btabdevelopment.com but the large insert in the middle is code I got form a project a former colleague had done. But he's no longer around.
The problem: I click the button and everything works OK. The file is created and formatted just how I want. If I click the button a second time though, it seems to run OK, but when I open the file it is NOT formatted. However, there’s another window behind it called “Book 1” which has all the data and all the correct formatting – it just hasn’t been saved. If I click it a third time I get an error message that says “Object variable or With block variable not set. “ I’m not even 100% all that is accurate because I have tried it a multitude of ways, closing and re-opening the form, closing and re-opening Access itself, starting with Excel open or closed, never with the destination excel file open though. I don’t seem to get exactly the same behaviour any two times. But as far as I can see, if I close and re-open Access, it always works the first time. So I can live with it.
But I’d like to understand what I done wrong. If I could understand this properly, I could apply the same principles in other places. This is where my lack of knowledge is evident. I’ve got myself mixed up with objects like xlSheet and ActiveSheet and I don’t really understand what I’m doing with them.
My gut feeling is that it's somehow connected with Access "releasing" Excel, saying "I'm done."
The task is (1) output an Access query to Excel (2) overwrite that file if it already exists (3) apply specific formatting to the header row and the other rows in Excel.
I have cobbled the code together from two sources. The beginning and end are adapted from code on btabdevelopment.com but the large insert in the middle is code I got form a project a former colleague had done. But he's no longer around.
The problem: I click the button and everything works OK. The file is created and formatted just how I want. If I click the button a second time though, it seems to run OK, but when I open the file it is NOT formatted. However, there’s another window behind it called “Book 1” which has all the data and all the correct formatting – it just hasn’t been saved. If I click it a third time I get an error message that says “Object variable or With block variable not set. “ I’m not even 100% all that is accurate because I have tried it a multitude of ways, closing and re-opening the form, closing and re-opening Access itself, starting with Excel open or closed, never with the destination excel file open though. I don’t seem to get exactly the same behaviour any two times. But as far as I can see, if I close and re-open Access, it always works the first time. So I can live with it.
But I’d like to understand what I done wrong. If I could understand this properly, I could apply the same principles in other places. This is where my lack of knowledge is evident. I’ve got myself mixed up with objects like xlSheet and ActiveSheet and I don’t really understand what I’m doing with them.
My gut feeling is that it's somehow connected with Access "releasing" Excel, saying "I'm done."
Code:
Private Sub cmdExport_Click()
On Error GoTo Errhandler
Dim rs As DAO.Recordset
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Set rs = CurrentDb.OpenRecordset("Cancer - Potential studies") ' A fairly simple SELECT query.
' Always runs OK when I double-click it in Access
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
oSheet.Activate
oSheet.Range("A1").Select
For Each fld In rs.Fields ' For every column in the query
oExcel.ActiveCell = fld.Name ' put the fieldname in the cell
oExcel.ActiveCell.Offset(0, 1).Select ' then move once cell to the right
Next
rs.MoveFirst
oSheet.Range("A2").CopyFromRecordset rs ' paste the results of the query
rs.Close
Set rs = Nothing
'====================================================================================
'Start of colleague's code
Dim tLoop As Long ' I don't understand why I don't need to Dim mLoop too
Set xlBookActive = ActiveWorkbook ' These don't appear to be DIMmed
Set xlSheet1 = xlBookActive.Worksheets(1) ' Do they need to be?
'Not sure what this loop actually does!
For tLoop = 2 To 65000 Step 1
If ActiveSheet.Range("a" & tLoop & ":a" & tLoop).Value = "" Then
Exit For
End If
Next tLoop
'Add a hyperlink to the StudyID number in column A
For mloop = 2 To (tLoop - 1) Step 1
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & mloop & ":A" & mloop), _
Address:="http://public.ukcrn.org.uk/Search/Portfolio.aspx?UKCRNStudyID=" & ActiveSheet.Range("A" & mloop & ":A" & mloop) & "&SearchType=Any", _
ScreenTip:="Portfolio Database", _
TextToDisplay:="Portfolio Database"
End With
Next mloop
'Not sure what this loop actually does either!
For tLoop = 1 To 65000 Step 1
If ActiveSheet.Range("a" & tLoop & ":a" & tLoop).Value = "" Then
Exit For
End If
Next tLoop
'Format alignment, borders, etc.
For mloop = 1 To (tLoop - 1) Step 1
With ActiveSheet.Range("A" & mloop & ":N" & mloop)
.Orientation = 0
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
'.Interior.Color = RGB(168, 255, 168)
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideVertical).Color = RGB(166, 166, 166)
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).Color = RGB(166, 166, 166)
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).Color = RGB(166, 166, 166)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeLeft).Color = RGB(166, 166, 166)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeRight).Color = RGB(166, 166, 166)
.Font.Size = 10
.Font.Name = "calibri"
.WrapText = True
End With
Next mloop
'Freeze panes to keep header row visible when scrolling down
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
End With
ActiveWindow.FreezePanes = True
'Formatting for headers in row 1
With xlSheet1.Range("A1:N1")
.Orientation = 0
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.Color = RGB(205, 207, 213)
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeBottom).Color = vbBlack
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeTop).Color = vbBlack
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Font.Bold = True
.RowHeight = 40
.WrapText = True
.AutoFilter
End With
'Turn off gridlines, since borders have been applied
ActiveWindow.DisplayGridlines = False
'Is this the problem? Or is something missing here?
Set xlMainSheet = Nothing
Set xlSheet1 = Nothing
'End of colleague's code
'====================================================================================
'Back to original code
oExcel.DisplayAlerts = False ' Allows overwrite if file already exists
oBook.SaveAs "C:\Documents and Settings\80435\Desktop\Possible Cancer Studies.xlsx"
oExcel.DisplayAlerts = True ' Never leave alerts turned off!
oExcel.Quit
Beep
MsgBox "'Possible Cancer Studies' file created on desktop"
Exit Sub
Errhandler:
MsgBox Err.Description
End Sub