A little background
Im trying to Export a Query to Excel. One of the field in the query has a criteria that is use to filter the data in the query. Im pretty new to VBA that is why I have no idea how to solve this.
Here is the code Im using.
Thank you in advance.
Im trying to Export a Query to Excel. One of the field in the query has a criteria that is use to filter the data in the query. Im pretty new to VBA that is why I have no idea how to solve this.
Here is the code Im using.
Code:
On Error GoTo SubError
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim SQL As String
Dim rs1 As DAO.Recordset
Dim i As Integer
DoCmd.Hourglass (True)
SQL = "SELECT [Reg], [Prov], [Mun], [Brgy], [Modal], [RecDateMonth], [RecDateYear], " & _
" [CommOpn], [CommCls], [BalCls], [PerCls] FROM [qrClsAccnt_Prew] WHERE [Brgy] = '" & Me.cboBrgy.Column(0) & "'"
Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
If rs1.RecordCount = 0 Then
MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If
Set xlApp = Excel.Application
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
With xlSheet
.Name = "Status of Closing of Accounts"
.Cells.Font.Name = "Calibri"
.Cells.Font.Size = 10
.Range("A1:J1").Merge True
.Range("A2:J1").Merge True
.Range("A3:J1").Merge True
.Range("A1").Value = "DEPARTMENT"
.Range("A2").Value = "KALAHI-CIDSS NCDDP"
.Range("A3").Value = "STATUS OF CLOSING OF ACCOUNTS"
.Range("A1:E1").Font.Size = 11
.Range("A2:E2").Font.Size = 11
.Range("A5:J5").Font.Size = 11
.Range("A5:J5").HorizontalAlignment = xlCenter
.Range("A5:E5").HorizontalAlignment = xlCenter
.Range("A5").Value = "Region"
.Range("B5").Value = "Province"
.Range("C5").Value = "Municipality"
.Range("D5").Value = "Barangay"
.Range("E5").Value = "Month"
.Range("F5").Value = "Year"
.Range("G5").Value = "No. of Community Accounts Opened"
.Range("H5").Value = "No. of Community Accounts Closed"
.Range("I5").Value = "% of Accounts Closure"
.Range("J5").Value = "Balance for Closing"
.Range("A5").ColumnWidth = 10
.Range("B5").ColumnWidth = 15
.Range("C5").ColumnWidth = 15
.Range("D5").ColumnWidth = 15
.Range("E5").ColumnWidth = 10
.Range("F5").ColumnWidth = 10
.Range("G5").ColumnWidth = 33
.Range("H5").ColumnWidth = 33
.Range("I5").ColumnWidth = 20
.Range("J5").ColumnWidth = 20
i = 6
Do While Not rs1.EOF
.Range("A6" & i).Value = Nz(rs1![Reg], "")
.Range("B6" & i).Value = Nz(rs1![Prov], "")
.Range("C6" & i).Value = Nz(rs1![Mun], "")
.Range("D6" & i).Value = Nz(rs1![Brgy], "")
.Range("E6" & i).Value = Nz(rs1![RecDateMonth], "")
.Range("F6" & i).Value = Nz(rs1![RecDateYear], "")
.Range("G6" & i).Value = Nz(rs1![CommOpn], 0)
.Range("H6" & i).Value = Nz(rs1![CommCls], 0)
.Range("I6" & i).Value = Nz(rs1![PerCls], 0)
.Range("J6" & i).Value = Nz(rs1![BalCls], 0)
i = i + 1
rs1.MoveNext
Loop
End With
SubExit:
On Error Resume Next
DoCmd.Hourglass False
xlApp.Visible = True
rs1.Close
Set rs1 = Nothing
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
GoTo SubExit
Thank you in advance.