TheOneAndOnlyWJA
New Member
- Joined
- Aug 4, 2020
- Messages
- 1
- Office Version
- 365
- Platform
- Windows
Hello all -
I am using Office / Excel 365 on a Windows 10 Pro laptop. I am writing a VBA script that will require me to include short cut keys to "Clear Data" on a fillable Adobe PDF using short cut keys...however, I cannot find any short cut keys that will allow me to do this (for Adobe). I was given on the Adobe forum a JavaScript of: this.resetForm(); however I never used JavaScrpt before and not too sure if JavaScript works with Excel VBA.
Thank you for any help you can give me... much appreciated!!
So far, my VBA code is as following:
Sub FillFLMAPDFForm()
Dim PDFTemplateFile As String, NewPDFFile As String, SavePDFFolder As String, EmployeeFirstName As String, EmployeeLastName As String
Dim Subj As String, Mesg As String, EmployersName As String, EmployeesJobTitle As String, EmployeesJobDescription As String
Dim EmployeeRow As Long, LastRow As Long
Dim OutApp As Object, OutMail As Object
If Sheet2.Range("E5").Value = Empty Then
MsgBox "Please Select A PDF Template To Use"
SetPDFTemplate
If Sheet2.Range("E5").Vaule = Empty Then Exit Sub
End If
PDFTemplateFile = Sheet2.Range("E5").Value ' Template File Name
With Sheet1
LastRow = .Range("A9999").End(xlUp).Row 'Last Employee Row
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00002
For EmployeeRow = 3 To LastRow
If .Range("M" & EmployeeRow).Value = Empty Then
EmployeeFirstName = .Range("A" & EmployeeRow).Value ' Employee First Name
EmployeeLastName = .Range("B" & EmployeeRow).Value ' Employee Lasrt Name
EmployerName = .Range("D" & EmployeeRow).Value ' Employer Name
JobTitle = .Range("F" & EmployeeRow).Value ' Employee Job Title
JobDescription = .Range("I" & EmployeeRow).Value ' Employee Job Description
Subj = Replace(Sheet2.Range("E7").Value, "#Name#", EmployeeFirstName) 'Email Subj
Mesg = Replace(Sheet2.Range("E9").Value, "#Name#", EmployeeFirstName) 'Email Meassage
NewPDFFile = ThisWorkbook.Path & "\" & EmployeeLastName & "_FMLA Attachement.PDF" 'New File Name
If Dir(NewPDFFile, vbDirectory) <> "" Then Kill (NewPDFFile) 'Delete File if exists ------------------------------------- VBA SCRIPT "If Dir(NewPDFFile, vbDirectory) <> "" Then" IS HIGHLIGHTED IN YELOW
'Clear Form
'Application.Wait Now + 0.00001
'Application.SendKeys
'Application.Wait Now + 0.00001
'ADD Fields
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesLastName
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesFirstName
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployersName
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesJobTitle
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesJobDescription
Application.Wait Now + 0.00002
Application.SendKeys "+^(s)", True
Application.Wait Now + 0.00002
Application.SendKeys NewPDFFile, True
Application.Wait Now + 0.00003
Application.SendKeys "%(s)" 'Save as
Application.Wait Now + 0.00003
'Create Email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateIteam(0)
With Outmail ---------------------------------RECEIVING ERROR MESSAGE "This Action Will Reset your project, proceed anyway?"
.To = EmailAdd
.Subect = Subj
.Body = Mesg
.Attachments.Add NewPDFFile
If Sheet2.Range("B5").Value = True Then .Display Else .Send 'Send or Display Email
'End With
.Range("M" & EmployeeRow).Value = Now 'Set Current Date &Time
AppActive "Adobe Acrobat Pro DC"
End If
Next EmployeeRow
Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True
End With
I am using Office / Excel 365 on a Windows 10 Pro laptop. I am writing a VBA script that will require me to include short cut keys to "Clear Data" on a fillable Adobe PDF using short cut keys...however, I cannot find any short cut keys that will allow me to do this (for Adobe). I was given on the Adobe forum a JavaScript of: this.resetForm(); however I never used JavaScrpt before and not too sure if JavaScript works with Excel VBA.
Thank you for any help you can give me... much appreciated!!
So far, my VBA code is as following:
Sub FillFLMAPDFForm()
Dim PDFTemplateFile As String, NewPDFFile As String, SavePDFFolder As String, EmployeeFirstName As String, EmployeeLastName As String
Dim Subj As String, Mesg As String, EmployersName As String, EmployeesJobTitle As String, EmployeesJobDescription As String
Dim EmployeeRow As Long, LastRow As Long
Dim OutApp As Object, OutMail As Object
If Sheet2.Range("E5").Value = Empty Then
MsgBox "Please Select A PDF Template To Use"
SetPDFTemplate
If Sheet2.Range("E5").Vaule = Empty Then Exit Sub
End If
PDFTemplateFile = Sheet2.Range("E5").Value ' Template File Name
With Sheet1
LastRow = .Range("A9999").End(xlUp).Row 'Last Employee Row
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00002
For EmployeeRow = 3 To LastRow
If .Range("M" & EmployeeRow).Value = Empty Then
EmployeeFirstName = .Range("A" & EmployeeRow).Value ' Employee First Name
EmployeeLastName = .Range("B" & EmployeeRow).Value ' Employee Lasrt Name
EmployerName = .Range("D" & EmployeeRow).Value ' Employer Name
JobTitle = .Range("F" & EmployeeRow).Value ' Employee Job Title
JobDescription = .Range("I" & EmployeeRow).Value ' Employee Job Description
Subj = Replace(Sheet2.Range("E7").Value, "#Name#", EmployeeFirstName) 'Email Subj
Mesg = Replace(Sheet2.Range("E9").Value, "#Name#", EmployeeFirstName) 'Email Meassage
NewPDFFile = ThisWorkbook.Path & "\" & EmployeeLastName & "_FMLA Attachement.PDF" 'New File Name
If Dir(NewPDFFile, vbDirectory) <> "" Then Kill (NewPDFFile) 'Delete File if exists ------------------------------------- VBA SCRIPT "If Dir(NewPDFFile, vbDirectory) <> "" Then" IS HIGHLIGHTED IN YELOW
'Clear Form
'Application.Wait Now + 0.00001
'Application.SendKeys
'Application.Wait Now + 0.00001
'ADD Fields
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesLastName
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesFirstName
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployersName
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesJobTitle
Application.Wait Now + 0.00002
Application.SendKeys "{Tab}", True
Application.SendKeys EmployeesJobDescription
Application.Wait Now + 0.00002
Application.SendKeys "+^(s)", True
Application.Wait Now + 0.00002
Application.SendKeys NewPDFFile, True
Application.Wait Now + 0.00003
Application.SendKeys "%(s)" 'Save as
Application.Wait Now + 0.00003
'Create Email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateIteam(0)
With Outmail ---------------------------------RECEIVING ERROR MESSAGE "This Action Will Reset your project, proceed anyway?"
.To = EmailAdd
.Subect = Subj
.Body = Mesg
.Attachments.Add NewPDFFile
If Sheet2.Range("B5").Value = True Then .Display Else .Send 'Send or Display Email
'End With
.Range("M" & EmployeeRow).Value = Now 'Set Current Date &Time
AppActive "Adobe Acrobat Pro DC"
End If
Next EmployeeRow
Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True
End With