Code:
Select Case MsgBox("This Will Take A Short While, As The Excel Sheet Is Formatted Nicely", vbOKCancel Or vbSystemModal, "Export To Exel")
Case vbOK
Dim ObjXlApp As Object
Dim ObjXlBook As Object
Dim ObjXlSheet As Object
Dim StrSql As String
Dim ObjRs1 As DAO.Recordset 'THIS IS AN Object
Dim IRowStart As Integer
Const XLCENTER = -4108
Const XLLEFT = -4131 'xlRight is -4152
Const XLCELLVALUE = 1
Const XLLESSEQUAL = 8
Const XLEQUAL = 3
Const XLNOBLANKSCONDITION = 13
'THIS IS THE SQL THAT CREATES THE EXCEL SHEET
StrSql = "SELECT Asset.AssetNumber AS [Asset Number], Asset.AssetName AS [Asset Name], AssetType.Type AS [Type Of Asset], AssetMake.Asset AS [Asset Make], AssetDetails.AssetModel, AssetLocation.Location AS [Asset Location], OperatingSystem.OperatingSystem AS [Operating System], Users.UserName, Asset.IPAddress " & vbCrLf & _
"FROM OperatingSystem INNER JOIN (Users INNER JOIN (AssetType INNER JOIN (AssetMake RIGHT JOIN (AssetLocation INNER JOIN (Asset INNER JOIN AssetDetails ON Asset.assetID = AssetDetails.AssetID) ON AssetLocation.assetLocationID = Asset.AssetLocation) ON AssetMake.AssetMakeID = AssetDetails.AssetMakeID) ON AssetType.AssetTypeID = Asset.AssetType) ON Users.UserID = Asset.UserID) ON OperatingSystem.OperatingSystemID = AssetDetails.OS " & vbCrLf & _
"GROUP BY Asset.AssetNumber, Asset.AssetName, AssetType.Type, AssetMake.Asset, AssetDetails.AssetModel, AssetLocation.Location, OperatingSystem.OperatingSystem, Users.UserName, Asset.IPAddress, Asset.AssetDisposedOf, AssetLocation.Location, Asset.assetID, AssetDetails.OS " & vbCrLf & _
"HAVING (((Asset.AssetDisposedOf)=False)) " & vbCrLf & _
"ORDER BY AssetType.Type, OperatingSystem.OperatingSystem DESC;"
'SHOW THE OUTPUT IN THE IMMEDIATE WINDOW
'Debug.Print StrSql
'EXECUTE QUERY AND POPULATE RECORDSET
Set ObjRs1 = CurrentDb.OpenRecordset(StrSql, dbOpenSnapshot)
'IF NO DATA, DON'T BOTHER OPENING EXCEL, JUST QUIT
If ObjRs1.RecordCount = 0 Then
MsgBox "NO DATA SELECTED FOR EXPORT", vbInformation + vbOKOnly, "NO DATA TO EXPORT"
Else
'WE SHALL TURN ON THE HOUR GLASS, SO THAT USERS KNOW THAT SOMETHING IS HAPPENING
DoCmd.Hourglass (True)
'CREATE AN INSTANCE OF EXCEL AND START BUILDING A SPREADSHEET LATE BINDING USED SO NO REFRENCES REQUIRED
Set ObjXlApp = CreateObject("Excel.Application")
'HIDE EXCEL FOR NOW
ObjXlApp.Visible = False
Set ObjXlBook = ObjXlApp.Workbooks.Add() 'START A NEW WORKBOOK
Set ObjXlSheet = ObjXlBook.Worksheets(1)
With ObjXlSheet
.Name = "IT Assets"
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 10
'FORMAT RANGE AS REQUIRED, TO BOLD A CELL USE THIS FOR EXAMPLE .RANGE("A1").CELLS.FONT.BOLD = TRUE
.Range("A1", "H1").Merge
.Range("A1").Columns.AutoFit
.Range("A2", "H2").Merge
.Range("A2").Columns.AutoFit
.Range("A1").HorizontalAlignment = XLLEFT
.Range("A2").HorizontalAlignment = XLLEFT
.Range("A1").Cells.Font.Name = "Franklin Gothic Book"
.Range("A2").Cells.Font.Name = "Franklin Gothic Book"
.Range("A1").Cells.Font.Size = 12
.Range("A2").Cells.Font.Size = 10
.Range("A1").Value = "IT Assets Details"
.Range("A1").Font.Color = vbBlue
.Range("A2").Value = "Exported ON" & " - " & Date
.Range("A2").Font.Color = vbBlue
'ADD HEADER IFORMING OF POSSIBLE EXTENDED RESOLUTION TIMES
.Range("A4", "H4").Merge
.Range("A4").Columns.AutoFit
.Range("A4").Cells.Font.Name = "Franklin Gothic Book"
.Range("A4").Cells.Font.Size = 10
.Range("A4").Value = "All Asset Details On Record"
.Range("A4").Font.Color = vbRed
'NOW WE SHALL BUILD THE COLUM HEADINGS.VALUE IS THE TEXT REQUIRED
.Range("A6").Value = "Asset Number"
.Range("B6").Value = "User Name"
.Range("C6").Value = "Asset Name"
.Range("D6").Value = "Type Of Asset"
.Range("E6").Value = "Asset Make"
.Range("F6").Value = "Asset Model"
.Range("G6").Value = "Asset Location"
.Range("H6").Value = "Operating System"
.Range("I6").Value = "IP Address"
'NOW WE APPLY COLOUR TO THE CELLS TO MAKE THEM LOOK NICE
.Range("A6:I6").Interior.ColorIndex = 37 '(37 IS THE BLUE COLOUR)
.Range("A6:I6").Borders.Weight = 3
'NOW WE FORMAT THE CELLS AS REQUIRED
.Range("A6:i6").Cells.Font.Bold = True
.Range("A6:i6").HorizontalAlignment = XLCENTER
.Range("A6:i6").Columns.AutoFit
'IROWSTART IS THE ROW THAT THE RECORDSET WILL ENTER DATA INTO
IRowStart = 7
'THEN WE LOOP THROUGH RECORDSET ABOVE AND COPY DATA FROM THE RECORDSET UNTIL WE GET TO THE END OF FILE
Do While Not ObjRs1.EOF
'START IMPORTING THE DATA FROM THE RECORD SET ABOVE INTO THE REQUIRED COLUMNS A,B,C,D IN THIS EXAMPLE
.Range("A" & IRowStart).Value = Nz(ObjRs1![Asset Number], "")
.Range("A" & IRowStart).HorizontalAlignment = XLCENTER
.Range("A" & IRowStart).ColumnWidth = 20
.Range("B" & IRowStart).Value = Nz(ObjRs1![UserName], "")
.Range("B" & IRowStart).HorizontalAlignment = XLCENTER
.Range("B" & IRowStart).ColumnWidth = 20
.Range("C" & IRowStart).Value = Nz(ObjRs1![Asset Name], 0)
.Range("C" & IRowStart).HorizontalAlignment = XLCENTER
.Range("C" & IRowStart).ColumnWidth = 25
.Range("D" & IRowStart).Value = Nz(ObjRs1![Type Of Asset], 0)
.Range("D" & IRowStart).HorizontalAlignment = XLCENTER
.Range("D" & IRowStart).ColumnWidth = 20
'NOW APPLY CONDITIONAL FORMATTING AS REQUIRED
With .Range("D" & IRowStart).FormatConditions.Add(XLCELLVALUE, XLEQUAL, "Laptop")
.Font.Color = vbBlue
End With
.Range("E" & IRowStart).Value = Nz(ObjRs1![Asset Make], 0)
.Range("E" & IRowStart).HorizontalAlignment = XLCENTER
.Range("E" & IRowStart).ColumnWidth = 25
.Range("F" & IRowStart).Value = Nz(ObjRs1![AssetModel], 0)
.Range("F" & IRowStart).HorizontalAlignment = XLCENTER
.Range("F" & IRowStart).ColumnWidth = 30
.Range("G" & IRowStart).Value = Nz(ObjRs1![Asset Location], 0)
.Range("G" & IRowStart).HorizontalAlignment = XLCENTER
.Range("G" & IRowStart).ColumnWidth = 35
.Range("H" & IRowStart).Value = Nz(ObjRs1![Operating System], 0)
.Range("H" & IRowStart).HorizontalAlignment = XLCENTER
.Range("H" & IRowStart).ColumnWidth = 30
'NOW APPLY CONDITIONAL FORMATTING AS REQUIRED
With .Range("H" & IRowStart).FormatConditions.Add(XLCELLVALUE, XLEQUAL, "Windows 7 Professional 32 Bit")
.Font.Color = vbRed
End With
.Range("I" & IRowStart).Value = Nz(ObjRs1![IPAddress], "") '"" WITH LEAVE THE CELL BLANK
.Range("I" & IRowStart).HorizontalAlignment = XLCENTER
.Range("I" & IRowStart).ColumnWidth = 15
'NOW APPLY CONDITIONAL FORMATTING AS REQUIRED
With .Range("I" & IRowStart).FormatConditions.Add(XLNOBLANKSCONDITION) 'FORMATS ALL CELLS THAT ARN'T BLANK
.Font.Color = vbRed
End With
IRowStart = IRowStart + 1
ObjRs1.MoveNext
Loop
'THEN WE SET A FOOTER, WE LEAVE A GAP OF 3 ROWS AND FORMAT THE FOOTER NICELY
IRowStart = IRowStart + 2
.Range("A" & IRowStart).Value = "These Are All The Asset Details That We Have On Record, These Do Not Include Assets That Have Been Disposed Of"
.Range("A" & IRowStart).Font.Color = vbRed
.Range("A" & IRowStart).HorizontalAlignment = XLLEFT
'PLACE THE CURSOR AT THE REQUIRED CELL
.Range("A7").Select
ObjXlApp.ActiveWindow.FreezePanes = True
.Range("A6:I6").Autofilter
'NOW WE SAVE THE NEWLY CREATED EXCELFILE TO THE NETWORK
ObjXlSheet.Application.DisplayAlerts = False
ObjXlSheet.SaveAs DLookup("FilePath", "Settings", "ID = 1") & "\IT" & "\Reports" & "\IT Assets" & "\IT Asset Report.xls"
ObjXlSheet.Application.DisplayAlerts = True
End With
'NOW WE CLOSE THE RECORD SETS AND RECLAIM ANY MEMORY HELD
DoCmd.Hourglass False
ObjXlApp.Visible = True
ObjRs1.Close
Set ObjRs1 = Nothing
Set ObjXlApp = Nothing
Set ObjXlBook = Nothing
Set ObjXlSheet = Nothing
'NOW WE OPEN THE FILE WE HAVE JUST SAVED
ObjXlApp.Visible = True
ObjXlApp.WindowState = 3
ObjXlApp.Workbooks.Open DLookup("FilePath", "Settings", "ID = 1") & "\IT" & "\Reports" & "\IT Assets" & "\IT Asset Report.xls"
End If
Case vbCancel