sub Experiment()
'On Error GoTo ErrorCheck
Dim db As Database
Dim qdf As QueryDef
Dim Pcount As Integer
Dim Pprogress As Integer
Dim NidsCount As Integer
Dim BreaksCount As Integer
Set db = CurrentDb
NidsCount = 0
For Each qdf In db.QueryDefs
If qdf.Name Like "*Daily Nids Report" Then
NidsCount = NidsCount + 1
End If
Next
BreaksCount = 0
For Each qdf In db.QueryDefs
If qdf.Name Like "*Daily Breakdown" Then
BreaksCount = BreaksCount + 1
End If
Next
Pcount = BreaksCount + NidsCount
DoCmd.OpenForm "FRMnidsprogress"
Pprogress = Forms![frmnidsprogress].Box4.Width / Pcount
Forms![frmnidsprogress].Text6 = "Running Nids And Breakdowns"
Forms![frmnidsprogress].Box5.Width = 0
Forms![frmnidsprogress].Box5.BackColor = 15898517
For Each qdf In db.QueryDefs
If qdf.Name Like "the Daily breakdown" Then
Else
If qdf.Name Like "*Daily breakdown" Then
DoCmd.TransferSpreadsheet acExport, 8, qdf.Name, "G:\nids test\emails\progressnids\" & qdf.Name & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
Forms![frmnidsprogress].Box5.Width = Forms![frmnidsprogress].Box5.Width + Pprogress
Forms![frmnidsprogress].Box5.BackColor = 15898517
End If
End If
Next
For Each qdf In db.QueryDefs
If qdf.Name Like "the Daily Nids Report" Then
Else
If qdf.Name Like "*Daily Nids Report" Then
DoCmd.TransferSpreadsheet acExport, 8, qdf.Name, "G:\nids test\emails\progressnids\FYI" & qdf.Name & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
Forms![frmnidsprogress].Box5.Width = Forms![frmnidsprogress].Box5.Width + Pprogress
End If
End If
Next
DoCmd.TransferSpreadsheet acExport, 8, "Sales Scotland Unique Apps", "G:\nids test\emails\progressnids\FYI" & "Sales Scotland Daily Nids Report" & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
'Sales Scotland Unique Apps
'Postcode reports
'Dim db As Database
Dim Area_Code_Table As Recordset
'Set db = CurrentDb
Dim LAF_Code As Integer
Dim Sales_Area1 As String
Dim Base_SQL As String
Dim QueryDefName As String
'Dim qdf As QueryDef
Dim RptName As String
Base_SQL = "Select [Daily Postcode Report].[CountOfAppnameref],[Daily Postcode Report].[Postcode],[Daily Postcode Report].[Addr First Line],[Daily Postcode Report].[To User],[Daily Postcode Report].[Application Ref],[Daily Postcode Report].[Application Name],[Daily Postcode Report].[Search Creation Date],[Daily Postcode Report].[Post Applied For],[Daily Postcode Report].[Notification id],[Daily Postcode Report].[LAF Code] from [Daily Postcode Report]where [Daily Postcode Report].[LAF code]="
Set Area_Code_Table = db.OpenRecordset("Postcode Report List")
Do While Not Area_Code_Table.EOF
LAF_Code = Area_Code_Table("Area Code")
Sales_Area1 = Area_Code_Table("sales area")
'QueryDefName = Sales_area1 & "" & " Hardship Case Escalations"
QueryDefName = "Daily Postcode Report Export"
CurrentDb.CreateQueryDef QueryDefName, Base_SQL & "'" & LAF_Code & "'"
'If DCount("*", Sales_area1 & "" & " Hardship Case Escalations") = 0 Then
'CurrentDb.QueryDefs.Delete QueryDefName
'Area_Code_Table.MoveNext
'Else
If DCount("*", "Daily Postcode Report Export") = 0 Then
CurrentDb.QueryDefs.Delete QueryDefName
Area_Code_Table.MoveNext
Else
RptName = Sales_Area1 & "" & " Daily Postcode Report"
Dim XLapp As New Excel.Application
Dim worksheet As Excel.worksheet
Dim ObjXL As Excel.Workbook
Set ObjXL = XLapp.Workbooks.Open("G:\nids test\emails\progressnids\template\Postcode report Template DO NOT DELETE OR MOVE.xls")
ObjXL.Application.Visible = True
ObjXL.Windows(1).Visible = True
ObjXL.Worksheets(2).Activate
Set worksheet = XLapp.Worksheets(2)
With worksheet
.range("A:J").ClearContents
End With
ObjXL.Save
ObjXL.Close
XLapp.Quit
DoCmd.TransferSpreadsheet acExport, 8, "Daily Postcode Report Export", "G:\nids test\emails\progressnids\template\Postcode report Template DO NOT DELETE OR MOVE"
Set ObjXL = XLapp.Workbooks.Open("G:\nids test\emails\progressnids\template\Postcode report Template DO NOT DELETE OR MOVE.xls")
ObjXL.Application.Visible = True
ObjXL.Windows(1).Visible = True
ObjXL.Worksheets(1).Activate
killsometime
ObjXL.SaveAs "G:\nids test\emails\progressnids\" & RptName & "_" & Format(Date, "ddmmyy") & ".xls", True, ""
ObjXL.Close
XLapp.Quit
Dim Skill As String
Skill = "taskkill /F /IM msexcel.exe"
'Shell Skill, vbHide
CurrentDb.QueryDefs.Delete QueryDefName
Area_Code_Table.MoveNext
End If
Loop
Exit Sub
Forms![frmnidsprogress].Box5.BackColor = 7095511
Forms![frmnidsprogress].Text6 = "Nids And Breakdowns Complete"
End Sub