Copy/paste picture and text without clipboard?

[Dabbler32]

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

[Dabbler32]

Thank you for looking at this (all who did). I figured it out. Finally. As follows:



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
Dim obj1 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)
ThisDocument.FormFields("EffectiveDate1").Result = mystr
ThisDocument.FormFields("EndDate1").Result = mystr2

str2 = VBA.Environ("Username")
str1 = "a" & str2 & ".docx"
txt1 = VBA.Environ("UserProfile")
txt2 = "Letters Written\"
txt4 = ThisDocument.FormFields("Insured1").Result
txt5 = ThisDocument.FormFields("ClaimNumber1").Result
txt6 = ThisDocument.FormFields("PolicyNumber1").Result
txt7 = "\Desktop\IAT\"
txt8 = "ROR\"
txt10 = txt1 & "\Desktop\IAT\Letters Written\ROR\DP 00 03 12 02\"
dte1 = ThisDocument.FormFields("DOL1").Result
dte2 = ThisDocument.FormFields("DOL3").Result
dte3 = ThisDocument.FormFields("EffectiveDate1").Result
dte4 = ThisDocument.FormFields("EndDate1").Result
ThisDocument.FormFields("DOL1").Result = Format(dte1, "long date")
ThisDocument.FormFields("DOL3").Result = Format(dte2, "long date")
ThisDocument.FormFields("EffectiveDate1").Result = Format(dte3, "long date")
ThisDocument.FormFields("EndDate1").Result = Format(dte4, "long date")
On Error GoTo 101
objWord.Documents.Open str1
On Error GoTo 0
ThisDocument.Unprotect
Set obj1 = Documents(str1).Range.Duplicate
ThisDocument.Bookmarks("SignatureLine").Range.FormattedText = obj1.FormattedText
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