Abbylovedon
10-11-2014, 03:00 PM
Hello-
Background:
We have this ridiculous invoicing program at my company that management refuses to abandon. So, it drove me to learn some VBA and write this macro. Basically, this code loops through a column of our customers, sending a series of keystrokes to our invoicing program, windows explorer, and Foxit-PhantomPDF in order to produce the end-result invoice that is emailed to our 1500 customers. I'm proud to say that I've gotten it to a point where it can run completely unmanned, and produce an invoice for a customer every 50 seconds (Even though most programs can produce well more than 1500 invoices in probably less than 5 seconds).
Problem:
In any case, is there no way to send keystrokes without AppActivate'ing or SetForegroundWindow(hWnd)'ing or interfering with what the user is working on??? Postmessage, Sendmessage, Sendkeys, Keybd_event - can none of these do this? IT Dept. will not allow an idle account/computer set up just to run a macro twice a month. Any help toward figuring out a way I could run this or something similar while still working on other things would GREATLY be appreciated. Thank you in advance!
Code Notes:
Excel 2013 - Windows 8
Code will run in a workplace
My VBA skills are at the beginner level
My API declarations are in a different module (I'm not sure if I should've included it, but I can provide it if you need it)
I know Sendkeys is the worst possible way to send keystrokes - but there was an API I found online that works with SendKeys and it seems to be the only way I can send keystrokes to the invoicing program (the invoicing application runs through RDC)
Code provided down below!
Option Explicit
'********************************************
' Invoice Software LOOP
'
' This will loop through the A column and
' create invoices based on the supplied
' values
'
' Don: Updated 10-11-2014
'********************************************
Public Sub Software_Loop()
Dim hWnd As Long
Dim StatusTxt As Range
Dim BeginDate As String
Dim EndDate As String
Dim InvoiceDate As String
Dim DueDate As String
Dim SaveSpot As String
Dim FolderName As String
Dim InvoicePG1 As String
Dim InvoicePG2 As String
Dim MyMsg As String
Dim CtrlShiftTabKey As String
Dim LeftKey As String
Dim ReturnKey As String
Dim AltKey As String
Dim DownKey As String
Dim TabKey As String
Dim ShiftTabKey As String
Dim i As Integer
Dim SaveLength As Integer
Dim SaveLess As Integer
Dim OpenPos As Integer
Dim ClosePos As Integer
'%%%%%%%%%%%% Set Objects %%%%%%%%%%%%%%
Set StatusTxt = Range("M4") 'Status
BeginDate = Range("E7").Value 'Begin Date Range
EndDate = Range("F7").Value 'End Date Range
InvoiceDate = Range("G7").Value 'Invoice Date
DueDate = Range("H7").Value 'Due Date
SaveSpot = Range("E12").Value 'Save Location
InvoicePG1 = "1"
InvoicePG2 = "1a"
SaveLength = Len(SaveSpot) 'Length
SaveLess = SaveLength - 1
ClosePos = InStrRev(SaveSpot, "\")
OpenPos = InStrRev(SaveSpot, "\", SaveLess)
FolderName = Mid(SaveSpot, OpenPos + 1, ClosePos - OpenPos - 1)
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Change status to invoicing
StatusTxt.Value = "Invoicing..."
StatusTxt.Font.Color = vbRed
'Begin the loop
Do
DoEvents
If IsEmpty(ActiveCell) Then
Exit Do
End If
ThisWorkbook.Save
'\\\\ Software \\\\\\'
'========================
' SEARCH THE GROUP
'========================
'Loop until the invoice management window is found
Do
hWnd = FindWindow(vbNullString, "Invoice Management (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
'Invoice window is open - Create new invoice
If hWnd Then
hWnd = SetForegroundWindow(hWnd)
CtrlShiftTabKey = "^(+{tab})"
SendCtrlShiftTabKey CtrlShiftTabKey
LeftKey = "{left}"
SendLeftKey LeftKey
ReturnKey = "{return}"
SendReturnKey ReturnKey
End If
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
'Enter group name based on active cell in Excel
MyMsg = ActiveCell.Value
For i = 1 To Len(MyMsg)
SendAKey Mid(MyMsg, i, 1)
Debug.Print Asc(Mid(MyMsg, i, 1))
Next i
SendAKey vbCr
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{return}"
SendReturnKey ReturnKey
'&^&^& Check for the NOT FOUND window &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Search Results (RDC.company.com)")
If hWnd Then 'Popup Occurs - Group can't be found
hWnd = SetForegroundWindow(hWnd)
'Exit the window
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{return}"
SendReturnKey ReturnKey
'Code group couldn't be found & move down to next group
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "GROUP NOT FOUND" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(1, 0).Select
GoTo LoopOver
End If
'========================
' CREATE A NEW INVOICE
'========================
'Press 'New Invoice' button
AltKey = "%" 'Alt
SendAltKey AltKey
DownKey = "{DOWN}" 'Down Arrow
SendDownKey DownKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'Next>>Next>>Next Buttons
Application.Wait (Now + TimeValue("0:00:03")) 'Wait \\\\\\\
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'Enter invoice date Information
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
For i = 1 To Len(BeginDate)
SendAKey Mid(BeginDate, i, 1)
Debug.Print Asc(Mid(BeginDate, i, 1))
Next i
SendAKey vbCr
For i = 1 To Len(EndDate)
SendAKey Mid(EndDate, i, 1)
Debug.Print Asc(Mid(EndDate, i, 1))
Next i
SendAKey vbCr
For i = 1 To Len(InvoiceDate)
SendAKey Mid(InvoiceDate, i, 1)
Debug.Print Asc(Mid(InvoiceDate, i, 1))
Next i
SendAKey vbCr
For i = 1 To Len(DueDate)
SendAKey Mid(DueDate, i, 1)
Debug.Print Asc(Mid(DueDate, i, 1))
Next i
SendAKey vbCr
'Proceed to the save screen
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'=========================
' CHECK IF INVOICE EXISTS
'=========================
'&^&^& Check for the Invoice already created window &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, _
"Invoice Creation Wizard (Fill in Invoice Dates:) (RDC.company.com)")
If hWnd Then 'Popup Occurs - Invoice exists error
hWnd = SetForegroundWindow(hWnd)
'Close the window
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "INVOICE EXISTS" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Selection.Offset(1, 0).Select
GoTo LoopOver
End If
'==================
' SAVE THE INVOICE
'==================
'// PAGE 1 \\
'Select the "Print Created Invoice" Output Option
DownKey = "{DOWN}" 'Down Arrow
SendDownKey DownKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
'&^&^& Check if the Select Printer window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, "Print (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "RESTART HERE1" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if the "Print to PDF Document - Foxit Reader PDF Printer" window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, _
"Print to PDF Document - Foxit Reader PDF Printer (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit Reader PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
MyMsg = SaveSpot & InvoicePG1 'Save the first page
For i = 1 To Len(MyMsg)
SendAKey Mid(MyMsg, i, 1)
Debug.Print Asc(Mid(MyMsg, i, 1))
Next i
SendAKey vbCr
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "RESTART HERE2" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if "Confirm Save As" popped up - A front page was left/not renamed &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Confirm Save As (RDC.company.com)")
If hWnd Then 'Popup Occurs - replace the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
'Code that a front page already existed
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "OVERWRITE1" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
End If
'&^&^& Close the Foxit Reader PDF Popups &^&^&
Do
hWnd = FindWindow(vbNullString, _
InvoicePG1 & ".pdf - Foxit Reader (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup open - Close the window
SendMessage hWnd, WM_SYSCOMMAND, SC_CLOSE, 0&
End If
'// PAGE 2 \\
'&^&^& Check if the Print window popped up 2nd time &^&^&
Do
hWnd = FindWindow(vbNullString, "Print (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit Reader PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "RESTART HERE3" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if the Print to PDF Document - Foxit Reader PDF Printer popped up 2nd time &^&^&
Do
hWnd = FindWindow(vbNullString, "Print to PDF Document - Foxit Reader PDF Printer (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit Reader PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
MyMsg = SaveSpot & InvoicePG2 'Invoice detail page
For i = 1 To Len(MyMsg)
SendAKey Mid(MyMsg, i, 1)
Debug.Print Asc(Mid(MyMsg, i, 1))
Next i
SendAKey vbCr
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "RESTART HERE4" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if "Confirm Save As" popped up - A detail page was left/not renamed &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Confirm Save As (RDC.company.com)")
If hWnd Then 'Popup Occurs - replace the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
'Code that a front page already existed
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "OVERWRITE2" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
End If
'&^&^& Close the Foxit Reader PDF Popups &^&^&
Do
hWnd = FindWindow(vbNullString, _
InvoicePG2 & ".pdf - Foxit Reader (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup open - Close the window
SendMessage hWnd, WM_SYSCOMMAND, SC_CLOSE, 0&
End If
'\\\\ Local PC \\\\\\'
'=====================
' COLLATE THE INVOICE
'=====================
'Open the InvoicePG2 file in Foxit
ShellExecute 0, "Open", SaveSpot & InvoicePG2 & ".pdf", "", "", vbNormalNoFocus
'&^&^& Check if the InvoicePG2 file opened in Foxit &^&^&
Do
hWnd = FindWindow(vbNullString, InvoicePG2 & ".pdf - Foxit PhantomPDF")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Insert the 1st page
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "%", True 'Alt
SendKeys "o", True 'O Key
SendKeys "f", True 'F Key
SendKeys "n", True 'N Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "f", True 'F Key
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "PDF DID NOT OPEN" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if the Foxit Open window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, "Open")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Select InvoicePG1 file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys SaveSpot & InvoicePG1, True 'File Location
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter
End If
'&^&^& Check if the Foxit Insert Files window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, "Insert Files")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Combine the files together
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{tab}", True 'Tab
SendKeys "{tab}", True 'Tab
SendKeys "{enter}", True 'Enter
End If
'&^&^& Save & close while checking if invoice is blank &^&^&
Do
hWnd = FindWindow(vbNullString, InvoicePG2 & ".pdf * - Foxit PhantomPDF")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Foxit PhantomPDF is open - save
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "%", True 'Alt
SendKeys "F", True 'F Key
SendKeys "S", True 'S Key
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys "%", True 'alt Key
SendKeys "d", True 'd Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "invoice", True 'invoice Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter Key
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Foxit PhantomPDF")
If hWnd Then 'Popup Occurs - Invoice word not found
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "BLANK" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
End If
End If
Do
hWnd = FindWindow(vbNullString, InvoicePG2 & ".pdf - Foxit PhantomPDF")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Insert the 1st page
SendMessage hWnd, WM_CLOSE, 0, 0&
End If
'=================
' RENAME THE FILE
'=================
'Open the folder containing the invoice
Shell "C:\Windows\explorer.exe /select, " & SaveSpot & InvoicePG2 & ".pdf", _
vbNormalFocus
'Rename file based on Active Cell
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Rename the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys "{f2}", True 'F2
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys ActiveCell.Value, True
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter
End If
'&^&^& Check for the confirm file name change &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Rename File")
If hWnd Then 'Window is open - Combine the files together
hWnd = SetForegroundWindow(hWnd)
SendKeys "{enter}", True 'Enter
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
End If
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Rename the file
SendMessage hWnd, WM_CLOSE, 0, 0&
End If
'Delete the InvoicePG2 file & close window
Shell "C:\Windows\explorer.exe /select, " & SaveSpot & InvoicePG1 & ".pdf", _
vbNormalFocus
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Delete the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{del}", True 'Del
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Rename the file
SendMessage hWnd, WM_CLOSE, 0, 0&
End If
End If
'Move down one cell
Selection.Offset(1, 0).Select
LoopOver:
Loop Until IsEmpty(ActiveCell)
'Change status to done
StatusTxt.Value = "DONE"
StatusTxt.Font.Color = vbGreen
Exit Sub
End Sub
Background:
We have this ridiculous invoicing program at my company that management refuses to abandon. So, it drove me to learn some VBA and write this macro. Basically, this code loops through a column of our customers, sending a series of keystrokes to our invoicing program, windows explorer, and Foxit-PhantomPDF in order to produce the end-result invoice that is emailed to our 1500 customers. I'm proud to say that I've gotten it to a point where it can run completely unmanned, and produce an invoice for a customer every 50 seconds (Even though most programs can produce well more than 1500 invoices in probably less than 5 seconds).
Problem:
In any case, is there no way to send keystrokes without AppActivate'ing or SetForegroundWindow(hWnd)'ing or interfering with what the user is working on??? Postmessage, Sendmessage, Sendkeys, Keybd_event - can none of these do this? IT Dept. will not allow an idle account/computer set up just to run a macro twice a month. Any help toward figuring out a way I could run this or something similar while still working on other things would GREATLY be appreciated. Thank you in advance!
Code Notes:
Excel 2013 - Windows 8
Code will run in a workplace
My VBA skills are at the beginner level
My API declarations are in a different module (I'm not sure if I should've included it, but I can provide it if you need it)
I know Sendkeys is the worst possible way to send keystrokes - but there was an API I found online that works with SendKeys and it seems to be the only way I can send keystrokes to the invoicing program (the invoicing application runs through RDC)
Code provided down below!
Option Explicit
'********************************************
' Invoice Software LOOP
'
' This will loop through the A column and
' create invoices based on the supplied
' values
'
' Don: Updated 10-11-2014
'********************************************
Public Sub Software_Loop()
Dim hWnd As Long
Dim StatusTxt As Range
Dim BeginDate As String
Dim EndDate As String
Dim InvoiceDate As String
Dim DueDate As String
Dim SaveSpot As String
Dim FolderName As String
Dim InvoicePG1 As String
Dim InvoicePG2 As String
Dim MyMsg As String
Dim CtrlShiftTabKey As String
Dim LeftKey As String
Dim ReturnKey As String
Dim AltKey As String
Dim DownKey As String
Dim TabKey As String
Dim ShiftTabKey As String
Dim i As Integer
Dim SaveLength As Integer
Dim SaveLess As Integer
Dim OpenPos As Integer
Dim ClosePos As Integer
'%%%%%%%%%%%% Set Objects %%%%%%%%%%%%%%
Set StatusTxt = Range("M4") 'Status
BeginDate = Range("E7").Value 'Begin Date Range
EndDate = Range("F7").Value 'End Date Range
InvoiceDate = Range("G7").Value 'Invoice Date
DueDate = Range("H7").Value 'Due Date
SaveSpot = Range("E12").Value 'Save Location
InvoicePG1 = "1"
InvoicePG2 = "1a"
SaveLength = Len(SaveSpot) 'Length
SaveLess = SaveLength - 1
ClosePos = InStrRev(SaveSpot, "\")
OpenPos = InStrRev(SaveSpot, "\", SaveLess)
FolderName = Mid(SaveSpot, OpenPos + 1, ClosePos - OpenPos - 1)
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Change status to invoicing
StatusTxt.Value = "Invoicing..."
StatusTxt.Font.Color = vbRed
'Begin the loop
Do
DoEvents
If IsEmpty(ActiveCell) Then
Exit Do
End If
ThisWorkbook.Save
'\\\\ Software \\\\\\'
'========================
' SEARCH THE GROUP
'========================
'Loop until the invoice management window is found
Do
hWnd = FindWindow(vbNullString, "Invoice Management (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
'Invoice window is open - Create new invoice
If hWnd Then
hWnd = SetForegroundWindow(hWnd)
CtrlShiftTabKey = "^(+{tab})"
SendCtrlShiftTabKey CtrlShiftTabKey
LeftKey = "{left}"
SendLeftKey LeftKey
ReturnKey = "{return}"
SendReturnKey ReturnKey
End If
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
'Enter group name based on active cell in Excel
MyMsg = ActiveCell.Value
For i = 1 To Len(MyMsg)
SendAKey Mid(MyMsg, i, 1)
Debug.Print Asc(Mid(MyMsg, i, 1))
Next i
SendAKey vbCr
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{return}"
SendReturnKey ReturnKey
'&^&^& Check for the NOT FOUND window &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Search Results (RDC.company.com)")
If hWnd Then 'Popup Occurs - Group can't be found
hWnd = SetForegroundWindow(hWnd)
'Exit the window
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{return}"
SendReturnKey ReturnKey
'Code group couldn't be found & move down to next group
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "GROUP NOT FOUND" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(1, 0).Select
GoTo LoopOver
End If
'========================
' CREATE A NEW INVOICE
'========================
'Press 'New Invoice' button
AltKey = "%" 'Alt
SendAltKey AltKey
DownKey = "{DOWN}" 'Down Arrow
SendDownKey DownKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'Next>>Next>>Next Buttons
Application.Wait (Now + TimeValue("0:00:03")) 'Wait \\\\\\\
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'Enter invoice date Information
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
For i = 1 To Len(BeginDate)
SendAKey Mid(BeginDate, i, 1)
Debug.Print Asc(Mid(BeginDate, i, 1))
Next i
SendAKey vbCr
For i = 1 To Len(EndDate)
SendAKey Mid(EndDate, i, 1)
Debug.Print Asc(Mid(EndDate, i, 1))
Next i
SendAKey vbCr
For i = 1 To Len(InvoiceDate)
SendAKey Mid(InvoiceDate, i, 1)
Debug.Print Asc(Mid(InvoiceDate, i, 1))
Next i
SendAKey vbCr
For i = 1 To Len(DueDate)
SendAKey Mid(DueDate, i, 1)
Debug.Print Asc(Mid(DueDate, i, 1))
Next i
SendAKey vbCr
'Proceed to the save screen
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'=========================
' CHECK IF INVOICE EXISTS
'=========================
'&^&^& Check for the Invoice already created window &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, _
"Invoice Creation Wizard (Fill in Invoice Dates:) (RDC.company.com)")
If hWnd Then 'Popup Occurs - Invoice exists error
hWnd = SetForegroundWindow(hWnd)
'Close the window
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
ReturnKey = "{return}" 'Enter
SendReturnKey ReturnKey
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "INVOICE EXISTS" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Selection.Offset(1, 0).Select
GoTo LoopOver
End If
'==================
' SAVE THE INVOICE
'==================
'// PAGE 1 \\
'Select the "Print Created Invoice" Output Option
DownKey = "{DOWN}" 'Down Arrow
SendDownKey DownKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
'&^&^& Check if the Select Printer window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, "Print (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "RESTART HERE1" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if the "Print to PDF Document - Foxit Reader PDF Printer" window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, _
"Print to PDF Document - Foxit Reader PDF Printer (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit Reader PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
MyMsg = SaveSpot & InvoicePG1 'Save the first page
For i = 1 To Len(MyMsg)
SendAKey Mid(MyMsg, i, 1)
Debug.Print Asc(Mid(MyMsg, i, 1))
Next i
SendAKey vbCr
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "RESTART HERE2" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if "Confirm Save As" popped up - A front page was left/not renamed &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Confirm Save As (RDC.company.com)")
If hWnd Then 'Popup Occurs - replace the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
'Code that a front page already existed
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "OVERWRITE1" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
End If
'&^&^& Close the Foxit Reader PDF Popups &^&^&
Do
hWnd = FindWindow(vbNullString, _
InvoicePG1 & ".pdf - Foxit Reader (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup open - Close the window
SendMessage hWnd, WM_SYSCOMMAND, SC_CLOSE, 0&
End If
'// PAGE 2 \\
'&^&^& Check if the Print window popped up 2nd time &^&^&
Do
hWnd = FindWindow(vbNullString, "Print (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit Reader PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "RESTART HERE3" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if the Print to PDF Document - Foxit Reader PDF Printer popped up 2nd time &^&^&
Do
hWnd = FindWindow(vbNullString, "Print to PDF Document - Foxit Reader PDF Printer (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup Occurs - Print to Foxit Reader PDF Printer
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ShiftTabKey = "+({tab})" 'Shift+Tab
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
SendShiftTabKey ShiftTabKey
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
MyMsg = SaveSpot & InvoicePG2 'Invoice detail page
For i = 1 To Len(MyMsg)
SendAKey Mid(MyMsg, i, 1)
Debug.Print Asc(Mid(MyMsg, i, 1))
Next i
SendAKey vbCr
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "RESTART HERE4" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if "Confirm Save As" popped up - A detail page was left/not renamed &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Confirm Save As (RDC.company.com)")
If hWnd Then 'Popup Occurs - replace the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
TabKey = "{tab}" 'Tab
SendTabKey TabKey
ReturnKey = "{enter}" 'Enter
SendReturnKey ReturnKey
'Code that a front page already existed
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "OVERWRITE2" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
End If
'&^&^& Close the Foxit Reader PDF Popups &^&^&
Do
hWnd = FindWindow(vbNullString, _
InvoicePG2 & ".pdf - Foxit Reader (RDC.company.com)")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Popup open - Close the window
SendMessage hWnd, WM_SYSCOMMAND, SC_CLOSE, 0&
End If
'\\\\ Local PC \\\\\\'
'=====================
' COLLATE THE INVOICE
'=====================
'Open the InvoicePG2 file in Foxit
ShellExecute 0, "Open", SaveSpot & InvoicePG2 & ".pdf", "", "", vbNormalNoFocus
'&^&^& Check if the InvoicePG2 file opened in Foxit &^&^&
Do
hWnd = FindWindow(vbNullString, InvoicePG2 & ".pdf - Foxit PhantomPDF")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Insert the 1st page
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "%", True 'Alt
SendKeys "o", True 'O Key
SendKeys "f", True 'F Key
SendKeys "n", True 'N Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "f", True 'F Key
Else
'Code the error
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "PDF DID NOT OPEN" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
Exit Do
End If
'&^&^& Check if the Foxit Open window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, "Open")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Select InvoicePG1 file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys SaveSpot & InvoicePG1, True 'File Location
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter
End If
'&^&^& Check if the Foxit Insert Files window popped up &^&^&
Do
hWnd = FindWindow(vbNullString, "Insert Files")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Combine the files together
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{tab}", True 'Tab
SendKeys "{tab}", True 'Tab
SendKeys "{enter}", True 'Enter
End If
'&^&^& Save & close while checking if invoice is blank &^&^&
Do
hWnd = FindWindow(vbNullString, InvoicePG2 & ".pdf * - Foxit PhantomPDF")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Foxit PhantomPDF is open - save
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "%", True 'Alt
SendKeys "F", True 'F Key
SendKeys "S", True 'S Key
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys "%", True 'alt Key
SendKeys "d", True 'd Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "invoice", True 'invoice Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter Key
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Foxit PhantomPDF")
If hWnd Then 'Popup Occurs - Invoice word not found
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter Key
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = ActiveCell.Value & "BLANK" '$$ERROR$$
ActiveCell.Font.Color = vbRed
ActiveCell.Offset(0, -1).Select
End If
End If
Do
hWnd = FindWindow(vbNullString, InvoicePG2 & ".pdf - Foxit PhantomPDF")
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Insert the 1st page
SendMessage hWnd, WM_CLOSE, 0, 0&
End If
'=================
' RENAME THE FILE
'=================
'Open the folder containing the invoice
Shell "C:\Windows\explorer.exe /select, " & SaveSpot & InvoicePG2 & ".pdf", _
vbNormalFocus
'Rename file based on Active Cell
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Rename the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
SendKeys "{f2}", True 'F2
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys ActiveCell.Value, True
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter
End If
'&^&^& Check for the confirm file name change &^&^&
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
hWnd = FindWindow(vbNullString, "Rename File")
If hWnd Then 'Window is open - Combine the files together
hWnd = SetForegroundWindow(hWnd)
SendKeys "{enter}", True 'Enter
Application.Wait (Now + TimeValue("0:00:02")) 'Wait \\\\\\\
End If
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Rename the file
SendMessage hWnd, WM_CLOSE, 0, 0&
End If
'Delete the InvoicePG2 file & close window
Shell "C:\Windows\explorer.exe /select, " & SaveSpot & InvoicePG1 & ".pdf", _
vbNormalFocus
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Delete the file
hWnd = SetForegroundWindow(hWnd)
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{del}", True 'Del
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
SendKeys "{enter}", True 'Enter
Application.Wait (Now + TimeValue("0:00:01")) 'Wait \\\\\\\
Do
hWnd = FindWindow(vbNullString, FolderName)
DoEvents
Sleep 200
Loop Until hWnd <> 0
If hWnd Then 'Window is open - Rename the file
SendMessage hWnd, WM_CLOSE, 0, 0&
End If
End If
'Move down one cell
Selection.Offset(1, 0).Select
LoopOver:
Loop Until IsEmpty(ActiveCell)
'Change status to done
StatusTxt.Value = "DONE"
StatusTxt.Font.Color = vbGreen
Exit Sub
End Sub