Procedure Won't Run

B

bconner

Registered User.
Local time
Today, 03:46
Joined
Dec 22, 2008
Messages
183
For some reason the code below creates the Excel Workbook and then stops and doesn't continue on to the Docmd statements. Am I missing something after the the SaveAs statement that saves the workbook and names it? As always, any help it greatly appreciated



Code: 
Private Sub Command3_Click()
Dim User As String
Dim xlBook As Object
Dim xlApp As Object
Dim GrpNumber As String
Dim RefLoc As String
 
'Capture User Name from Windows Login
User = Environ$("USERNAME")
 
' Create Excel Workbook to Export DeepDive Queries into
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.workbooks.Add
RefLoc = Form_FrmDeepDiveConsolidatedReports.Combo_LocationName.Value
GrpNumber = Form_FrmDeepDiveConsolidatedReports.Txt_Grp.Value
xlBook.SaveAs ("C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls")
 
 
On Error GoTo SendError
 
'Aetna Reports
DoCmd.TransferSpreadsheet acExport, , "90AA AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90AAA AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90AAAA AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
'BCBS Reports
DoCmd.TransferSpreadsheet acExport, , "90BB AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90BBB AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90BBBB AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
'CHAMPVA Reports
DoCmd.TransferSpreadsheet acExport, , "90CC AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90CCC AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90CCCC AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
 
'CHARITY Reports
DoCmd.TransferSpreadsheet acExport, , "90DD AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90DDD AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90DDDD AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
'CIGNA Reports
DoCmd.TransferSpreadsheet acExport, , "90EE AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90EEE AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90EEEE AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
'CONTRACTED Reports
DoCmd.TransferSpreadsheet acExport, , "90FF AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90FFF AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90FFFF AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
'HUMANA Reports
DoCmd.TransferSpreadsheet acExport, , "90GG AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90GGG AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90GGGG AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
 
'MEDICAID Reports
DoCmd.TransferSpreadsheet acExport, , "90HH AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90HHH AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90HHHH AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
'MEDICARE Reports
DoCmd.TransferSpreadsheet acExport, , "90II AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90III AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90IIII AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
 
'Tricare Reports
DoCmd.TransferSpreadsheet acExport, , "90JJ AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90JJJ AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90JJJJ AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
 
'UHC Reports
DoCmd.TransferSpreadsheet acExport, , "90KK AR Sum By Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90KKK AR by FSC", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
DoCmd.TransferSpreadsheet acExport, , "90KKKK AR by FSC by Rej", "C:\Documents and Settings\" & User & "\Desktop\DeepDiveReports\" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Reports.xls", True
 
 
If User = swoodring Then
DoCmd.SendObject , , , "User" & "@ameripath.com", "[EMAIL="bconner@ameripath.com"]bconner@ameripath.com[/EMAIL]", , "Group" & " " & GrpNumber & " " & RefLoc & " " & "Deep Dive Reports are Complete", , False
If User = bconner Then
DoCmd.SendObject , , , "User" & "@ameripath.com", "[EMAIL="swoodring@ameripath.com"]swoodring@ameripath.com[/EMAIL]", , "Group" & " " & GrpNumber & " " & RefLoc & " " & "Deep Dive Reports are Complete", , False
End If
End If
 
Exit Sub
 
' If Error occurs send out an email with Error number and Description
SendError:
If User = swoodring Then
DoCmd.SendObject , , , "User" & "@ameripath.com", "[EMAIL="bconner@ameripath.com"]bconner@ameripath.com[/EMAIL]", , "Error Occurred with Group" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Report Exports to Excel", Err.Number & " " & Err.Description, False
If User = bconner Then
DoCmd.SendObject , , , "User" & "@ameripath.com", "[EMAIL="swoodring@ameripath.com"]swoodring@ameripath.com[/EMAIL]", , "Error Occurred with Group" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Report Exports to Excel", Err.Number & " " & Err.Description, False
End If
End If
 
End Sub
 
Have you set a breakpoint and followed the code? I suspect it's going into the error trap, and not doing anything there, because neither test is met. You probably need a test there like:

If User = "swoodring" Then

By the way, the logic of the error trap would prevent the

If User = bconner Then

line from ever being met. It would only get there if the user was swoodring, so it obviously couldn't be bconner at that point. Maybe indenting will show why:

Code: 
  If User = swoodring Then
    DoCmd.SendObject , , , "User" & "@ameripath.com", "bconner@ameripath.com", , "Error Occurred with Group" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Report Exports to Excel", Err.Number & " " & Err.Description, False
    If User = bconner Then
      DoCmd.SendObject , , , "User" & "@ameripath.com", "swoodring@ameripath.com", , "Error Occurred with Group" & " " & GrpNumber & " " & RefLoc & " " & "DeepDive Report Exports to Excel", Err.Number & " " & Err.Description, False
    End If
  End If
 
You must log in or register to reply here.

Similar threads

L
Solved Run Dos Command in VBA
Replies
19
Views
1,274
GPGeorge
GPGeorge
oxicottin
Solved Import from excel and delete unwanted data
Replies
14
Views
1,770
oxicottin
oxicottin
oxicottin
Solved Export search form data to excel
Replies
11
Views
1,375
oxicottin
oxicottin
oxicottin
Solved Out Of Memory error when emailing
Replies
8
Views
1,032
oxicottin
oxicottin
M
I need to create a workbook with multiple sheets
Replies
3
Views
1,107
ebs17
E

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom