Hi Gmayor,
Thanks for your input on this thread. I am able to open the protected file, but not able to edit it. I have the code which renames the word doc and the code is working fine on the protected document as well. When the code tries to convert the protected doc from word to PDF I see that the file is open and the code gets hanged. I am also able to open the protected document without any issue. Sorry I won’t be able to share the document because of its confidentiality. I took the screenshot of the edited section and it is attached with the mail.
Also, find the code I am using to rename and converting the word file to PDF and also deleting the word doc after converting them to PDF.
The line of code where the macro gets hanged is this one
ActiveDocument.ExportAsFixedFormat OutputFileName:=strDocName, ExportFormat:=wdExportFormatPDF
Sub RenameDocumentsTreaty()
Application.ScreenUpdating = False
Dim strFldr As String, strDocNm As String, strFile As String, strNewNm As String, wdDoc As Document
Dim FSO As Object, objFile As Object
Dim fs As Object
Dim oFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim intPos As Integer
Dim fileType As String
Dim MyFile As String
On Error Resume Next
fileType = "PDF"
Set fs = CreateObject("Scripting.FileSystemObject")
strDocNm = ActiveDocument.FullName
strFldr = InputBox("Please add folder link for treaty doc")
If strFldr = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
strFldr = strFldr & "\"
strFile = Dir(strFldr & "*.doc", vbNormal)
While strFile <> ""
If strFldr & strFile <> strDocNm Then
Set wdDoc = Documents.Open(FileName:=strFldr & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
strNewNm = .SelectContentControlsByTitle("DC\Name")(1).Range.Text _
& "_" & .SelectContentControlsByTitle("DC\BrokerReference1")(1).Range.Text _
& .SelectContentControlsByTitle("DC\BrokerReference2")(1).Range.Text _
& "_" & .SelectContentControlsByTitle("DC\NettAmt")(1).Range.Text _
& "." & Split(.Name, ".")(UBound(Split(.Name, ".")))
'strNewNm = strNewNm & "." & Split(.Name, ".")(UBound(Split(.Name, ".")))
.Close SaveChanges:=False
End With
If FSO.FileExists(strFldr & strNewNm) Then
ActiveDocument.Range.InsertAfter "Unable to create:" & Chr(11) & strFldr & strNewNm & Chr(11) & "File Exists" & vbCr
Else
Set objFile = FSO.GetFile(strFldr & strFile)
objFile.Name = strNewNm
End If
End If
strFile = Dir()
Wend
Set oFolder = fs.GetFolder(strFldr)
For Each oFile In oFolder.Files
Dim d As Document
Set d = Application.Documents.Open(oFile.Path)
strDocName = ActiveDocument.Name
intPos = InStrRev(strDocName, ".")
strDocName = Left(strDocName, intPos - 1)
ChangeFileOpenDirectory oFolder
fileType = "PDF"
strDocName = strDocName & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:=strDocName, ExportFormat:=wdExportFormatPDF
d.Saved = True
d.Close
ChangeFileOpenDirectory oFolder
Next oFile
MyFile = Dir$(strFldr & "\*.doc*")
Do While MyFile <> ""
KillProperly strFldr & "\" & MyFile
MyFile = Dir$(strFldr & "\*.docx")
Loop
Set wdDoc = Nothing: Set objFile = Nothing: Set FSO = Nothing
Application.ScreenUpdating = True
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Public Sub KillProperly(Killfile As String)
If Len(Dir$(Killfile)) > 0 Then
SetAttr Killfile, vbNormal
Kill Killfile
End If
End Sub
Regards,
JD
VBA to convert Password protected Word Doc into PDF.
Reply With Quote
