Dabbler32
11-04-2015, 09:09 AM
Hello.
I am trying to copy/paste from one document to another as witnessed by my code below. However, I would like to avoid using the clipboard for a variety of reasons inclusive of the fact that my code is leaving a blank instance of word open and when I close it, clipboard asks me if I want to save the data, which I don't. Additionally, my reading through posts seems to lead me to believe that copy/paste is not the most efficient or preferred method.
So, anyone who is able to decipher my mess is welcome to help me. Thanks!!!!:crying:
BTW: this code is in a userform as evidenced by the unload me line.
Private Sub CommandButton1_Click()
Dim mystr, mystr2, dte1, dte2, dte3, dte4 As Date
Dim str1, str2, str3, txt1, txt2, txt4, txt5, txt6, txt7, txt8, txt10
Dim objWord As Object
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
If IsDate(UserForm6.TextBox1.Value) = False Or Len(UserForm6.TextBox1.Value) < 10 Then
MsgBox ("Must enter a valid date being mm/dd/yyyy")
UserForm6.TextBox1.Value = Null
Cancel = True
If UserForm6.TextBox1 = vbNullString Then Exit Sub
End If
mystr = UserForm6.TextBox1
mystr2 = DateAdd("yyyy", 1, mystr)
ActiveDocument.FormFields("EffectiveDate1").Result = mystr
ActiveDocument.FormFields("EndDate1").Result = mystr2
str2 = VBA.Environ("Username")
str1 = "\\obufs01\common\Templates\Signatures\" & str2 & ".docx"
txt1 = VBA.Environ("UserProfile")
txt2 = "Letters Written\"
txt4 = ActiveDocument.FormFields("Insured1").Result
txt5 = ActiveDocument.FormFields("ClaimNumber1").Result
txt6 = ActiveDocument.FormFields("PolicyNumber1").Result
txt7 = "\Desktop\IAT\"
txt8 = "ROR\"
txt10 = txt1 & "\Desktop\IAT\Letters Written\ROR\DP 00 03 12 02\"
dte1 = ActiveDocument.FormFields("DOL1").Result
dte2 = ActiveDocument.FormFields("DOL3").Result
dte3 = ActiveDocument.FormFields("EffectiveDate1").Result
dte4 = ActiveDocument.FormFields("EndDate1").Result
ActiveDocument.FormFields("DOL1").Result = Format(dte1, "long date")
ActiveDocument.FormFields("DOL3").Result = Format(dte2, "long date")
ActiveDocument.FormFields("EffectiveDate1").Result = Format(dte3, "long date")
ActiveDocument.FormFields("EndDate1").Result = Format(dte4, "long date")
On Error GoTo 101
objWord.Documents.Open str1
On Error GoTo 0
With objWord.Documents(str1)
ActiveDocument.Range.CopyAsPicture
End With
ThisDocument.Unprotect
ThisDocument.Bookmarks("SignatureLine").Range.PasteSpecial (ppPasteMetafilePicture)
objWord.DisplayAlerts = 0
objWord.Documents(str1).Close SaveChanges:=wdDoNotSaveChanges
Set objWord = Nothing
102
Unload Me
If Dir(txt1 & txt7, vbDirectory) = "" Then
MkDir Path:=txt1 & txt7
End If
If Dir(txt1 & txt7 & txt2, vbDirectory) = "" Then
MkDir Path:=txt1 & txt7 & txt2
End If
If Dir(txt1 & txt7 & txt2 & txt8, vbDirectory) = "" Then
MkDir Path:=txt1 & txt7 & txt2 & txt8
End If
If Dir(txt10, vbDirectory) = "" Then
MkDir Path:=txt10
End If
ThisDocument.SaveAs FileName:=txt10 & "ACK Letter " & txt4 & " Claim#" & txt5 & " Policy#" & txt6 & ".docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:=""
GoTo 1000
101
MsgBox "Sorry, I am unable to add your signature to the letter. Please see your administrator."
ThisDocument.Unprotect
GoTo 102
1000
ThisDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub
I am trying to copy/paste from one document to another as witnessed by my code below. However, I would like to avoid using the clipboard for a variety of reasons inclusive of the fact that my code is leaving a blank instance of word open and when I close it, clipboard asks me if I want to save the data, which I don't. Additionally, my reading through posts seems to lead me to believe that copy/paste is not the most efficient or preferred method.
So, anyone who is able to decipher my mess is welcome to help me. Thanks!!!!:crying:
BTW: this code is in a userform as evidenced by the unload me line.
Private Sub CommandButton1_Click()
Dim mystr, mystr2, dte1, dte2, dte3, dte4 As Date
Dim str1, str2, str3, txt1, txt2, txt4, txt5, txt6, txt7, txt8, txt10
Dim objWord As Object
Set objWord = GetObject(, "Word.Application")
objWord.Visible = True
If IsDate(UserForm6.TextBox1.Value) = False Or Len(UserForm6.TextBox1.Value) < 10 Then
MsgBox ("Must enter a valid date being mm/dd/yyyy")
UserForm6.TextBox1.Value = Null
Cancel = True
If UserForm6.TextBox1 = vbNullString Then Exit Sub
End If
mystr = UserForm6.TextBox1
mystr2 = DateAdd("yyyy", 1, mystr)
ActiveDocument.FormFields("EffectiveDate1").Result = mystr
ActiveDocument.FormFields("EndDate1").Result = mystr2
str2 = VBA.Environ("Username")
str1 = "\\obufs01\common\Templates\Signatures\" & str2 & ".docx"
txt1 = VBA.Environ("UserProfile")
txt2 = "Letters Written\"
txt4 = ActiveDocument.FormFields("Insured1").Result
txt5 = ActiveDocument.FormFields("ClaimNumber1").Result
txt6 = ActiveDocument.FormFields("PolicyNumber1").Result
txt7 = "\Desktop\IAT\"
txt8 = "ROR\"
txt10 = txt1 & "\Desktop\IAT\Letters Written\ROR\DP 00 03 12 02\"
dte1 = ActiveDocument.FormFields("DOL1").Result
dte2 = ActiveDocument.FormFields("DOL3").Result
dte3 = ActiveDocument.FormFields("EffectiveDate1").Result
dte4 = ActiveDocument.FormFields("EndDate1").Result
ActiveDocument.FormFields("DOL1").Result = Format(dte1, "long date")
ActiveDocument.FormFields("DOL3").Result = Format(dte2, "long date")
ActiveDocument.FormFields("EffectiveDate1").Result = Format(dte3, "long date")
ActiveDocument.FormFields("EndDate1").Result = Format(dte4, "long date")
On Error GoTo 101
objWord.Documents.Open str1
On Error GoTo 0
With objWord.Documents(str1)
ActiveDocument.Range.CopyAsPicture
End With
ThisDocument.Unprotect
ThisDocument.Bookmarks("SignatureLine").Range.PasteSpecial (ppPasteMetafilePicture)
objWord.DisplayAlerts = 0
objWord.Documents(str1).Close SaveChanges:=wdDoNotSaveChanges
Set objWord = Nothing
102
Unload Me
If Dir(txt1 & txt7, vbDirectory) = "" Then
MkDir Path:=txt1 & txt7
End If
If Dir(txt1 & txt7 & txt2, vbDirectory) = "" Then
MkDir Path:=txt1 & txt7 & txt2
End If
If Dir(txt1 & txt7 & txt2 & txt8, vbDirectory) = "" Then
MkDir Path:=txt1 & txt7 & txt2 & txt8
End If
If Dir(txt10, vbDirectory) = "" Then
MkDir Path:=txt10
End If
ThisDocument.SaveAs FileName:=txt10 & "ACK Letter " & txt4 & " Claim#" & txt5 & " Policy#" & txt6 & ".docx", FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:=""
GoTo 1000
101
MsgBox "Sorry, I am unable to add your signature to the letter. Please see your administrator."
ThisDocument.Unprotect
GoTo 102
1000
ThisDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub