#1
|
|||
|
|||
Cant save document as docx or doc using macro in Word 2007
Hi guys,
I have this macro Code:
Option Explicit Sub BAAR() Dim oFolder As Object Dim oSubFolder As Object Dim fso As Object Dim oDoc As Document Dim fisword As String Dim FOLDER As String Dim cinci As String Dim cinci1 As String Dim raport As String Dim BAAR As String Dim baar1 As String Dim nr As String Dim nr1 As String Dim MARCA As String Dim marca1 As String Dim data As String Dim anexa1 As String Dim anexa5 As String Dim AUDATEX As String Dim strSubFolderPath As String Dim strsubfoldernewname As String Dim strmessageAU As String Dim strmessageCT As String Dim strmessageEN As String Const strDrive As String = "D:\MIHAI\BAAR\" raport = Trim(ActiveDocument.BuiltInDocumentProperties("Title").Value) BAAR = Replace(Trim(ActiveDocument.BuiltInDocumentProperties("keywords").Value), "/", ".") & Chr(32) baar1 = ActiveDocument.BuiltInDocumentProperties("keywords").Value nr = Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Company").Value), Chr(45), "") MARCA = ActiveDocument.BuiltInDocumentProperties("Comments").Value nr1 = Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Company").Value), Chr(150), "-") marca1 = MARCA & ", " & nr1 data = ActiveDocument.BuiltInDocumentProperties("Content status").Value If Len(baar1) = 20 Then cinci = Right(Replace(Trim(ActiveDocument.BuiltInDocumentProperties("keywords").Value), "/", ".") & Chr(32), 6) cinci1 = Replace(cinci, " ", "") End If If Len(baar1) > 20 Then cinci = Right(Replace(Trim(ActiveDocument.BuiltInDocumentProperties("keywords").Value), "/", ".") & Chr(32), 9) cinci1 = Replace(cinci, " ", "") End If fisword = "R" & raport & "_" & BAAR & nr & " " & MARCA FOLDER = "BAAR-Dosar" & raport & "_" & cinci1 & " " & nr & " " & MARCA & "-" & data & "" anexa1 = "Anexa4_R" & raport & "_" & "DevizAudatex " & nr anexa5 = "Anexa5_R" & raport & "_" & "Evaluare auto " & nr AUDATEX = "Anexa4" & " - Calcula" & ChrW(539) & "ie deviz de repara" & ChrW(539) & "ii pentru auto " & MARCA & " cu nr. de înmatriculare " & ActiveDocument.BuiltInDocumentProperties("Company").Value strsubfoldernewname = strDrive & FOLDER Set fso = CreateObject("Scripting.FileSystemObject") Set oFolder = fso.GetFolder(strDrive) For Each oSubFolder In oFolder.SubFolders If Not oSubFolder.Name Like "MICHAEL_*" Then 'Optional strSubFolderPath = oSubFolder.Path Name strSubFolderPath As strsubfoldernewname Exit For End If 'Optional Next oSubFolder Set fso = Nothing Set oFolder = Nothing Set oSubFolder = Nothing FileCopy strDrive & "RP.vcp", strsubfoldernewname & "\RP.vcp" MkDir strsubfoldernewname & "\X\" ActiveDocument.SaveAs2 strsubfoldernewname & "\X\" & "_" & fisword & ".docx" ActiveDocument.SaveAs2 FileName:=strsubfoldernewname & "\" & fisword & ".doc", FileFormat:=wdFormatDocument ActiveDocument.ExportAsFixedFormat OutputFileName:=strsubfoldernewname & "\X\" & "_" & anexa1 & ".pdf", _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, From:=1, to:=1, _ Item:=wdExportDocumentContent, _ IncludeDocProps:=True, _ KeepIRM:=True, _ CreateBookmarks:=wdExportCreateHeadingBookmarks, _ DocStructureTags:=True, _ BitmapMissingFonts:=True, _ UseISO19005_1:=False ActiveDocument.ExportAsFixedFormat OutputFileName:=strsubfoldernewname & "\X\" & "_" & anexa5 & ".pdf", _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, From:=1, to:=1, _ Item:=wdExportDocumentContent, _ IncludeDocProps:=True, _ KeepIRM:=True, _ CreateBookmarks:=wdExportCreateHeadingBookmarks, _ DocStructureTags:=True, _ BitmapMissingFonts:=True, _ UseISO19005_1:=False ActiveDocument.ExportAsFixedFormat OutputFileName:=strsubfoldernewname & "\X\" & "_" & AUDATEX & ".pdf", _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, From:=1, to:=1, _ Item:=wdExportDocumentContent, _ IncludeDocProps:=True, _ KeepIRM:=True, _ CreateBookmarks:=wdExportCreateHeadingBookmarks, _ DocStructureTags:=True, _ BitmapMissingFonts:=True, _ UseISO19005_1:=False ActiveDocument.ExportAsFixedFormat OutputFileName:=strsubfoldernewname & "\X\" & marca1 & ".pdf", _ ExportFormat:=wdExportFormatPDF, _ OpenAfterExport:=False, _ OptimizeFor:=wdExportOptimizeForPrint, _ Range:=wdExportAllDocument, From:=1, to:=1, _ Item:=wdExportDocumentContent, _ IncludeDocProps:=True, _ KeepIRM:=True, _ CreateBookmarks:=wdExportCreateHeadingBookmarks, _ DocStructureTags:=True, _ BitmapMissingFonts:=True, _ UseISO19005_1:=False strmessageAU = "Raport de verif R pt. dosar " & baar1 & vbCr & vbCr & vbCr & _ "In atentia d-lui Adrian Uta" & "," & vbCr & vbCr & _ "Urmare a verificarii dosarului " & baar1 & " auto pagubit marca " & MARCA & " " & _ "va transmitem atasat raportul de verificare." & vbCr & _ "Rog confirmati primirea." & vbCr & vbCr & _ "Cu stima," & vbCr & "Mihai STAICU" strmessageCT = "Raport de verif R pt. dosar " & baar1 & vbCr & vbCr & vbCr & _ "In atentia d-lui Cristi Turcu" & "," & vbCr & vbCr & _ "Urmare a verificarii dosarului " & baar1 & " auto pagubit marca " & MARCA & " " & _ "va transmitem atasat raportul de verificare." & vbCr & _ "Rog confirmati primirea." & vbCr & vbCr & _ "Cu stima," & vbCr & "Mihai STAICU" strmessageEN = "Raport de verif R pt. dosar " & baar1 & vbCr & vbCr & vbCr & _ "In atentia d-nei Emilia Negoita" & "," & vbCr & vbCr & _ "Urmare a verificarii dosarului " & baar1 & " auto pagubit marca " & MARCA & " " & _ "va transmitem atasat raportul de verificare." & vbCr & _ "Rog confirmati primirea." & vbCr & vbCr & _ "Cu stima," & vbCr & "Mihai STAICU" Set fso = CreateObject("Scripting.FileSystemObject") Select Case True Case fso.FileExists(strsubfoldernewname & "\" & "Mail AU.docx") Set oDoc = Documents.Add(Template:=strsubfoldernewname & "\" & "Mail AU.docx") oDoc.Range.Text = strmessageAU oDoc.SaveAs2 FileName:=strsubfoldernewname & "\X\" & "XAU.docx", addtorecentfiles:=False Case fso.FileExists(strsubfoldernewname & "\" & "Mail CT.docx") Set oDoc = Documents.Add(Template:=strsubfoldernewname & "\" & "Mail CT.docx") oDoc.Range.Text = strmessageCT oDoc.SaveAs2 FileName:=strsubfoldernewname & "\X\" & "XCT.docx", addtorecentfiles:=False Case fso.FileExists(strsubfoldernewname & "\" & "Mail EN.docx") Set oDoc = Documents.Add(Template:=strsubfoldernewname & "\" & "Mail EN.docx") oDoc.Range.Text = strmessageEN oDoc.SaveAs2 FileName:=strsubfoldernewname & "\X\" & "XEN.docx", addtorecentfiles:=False End Select Set fso = Nothing Set oDoc = Nothing With Application .ScreenUpdating = False Do Until .Documents.Count = 0 .Documents(1).Close SaveChanges:=wdDoNotSaveChanges Loop .Quit SaveChanges:=wdDoNotSaveChanges End With lbl_Exit: Exit Sub End Sub The errors I get are: Run-time error '438': Object doesn't support this property or method. at the following lines: ActiveDocument.SaveAs2 strsubfoldernewname & "\X\" & "_" & fisword & ".docx" ActiveDocument.SaveAs2 FileName:=strsubfoldernewname & "\" & fisword & ".doc", FileFormat:=wdFormatDocument oDoc.SaveAs2 FileName:=strsubfoldernewname & "\X\" & "XEN.docx", addtorecentfiles:=False Do you have any idea what can I do to make it work ? Thanks. |
#2
|
|||
|
|||
Check the filenames in the saveas2 commands for illegal filename characters.
|
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Save 6x9 2007 Word document to 6x9 PDF | Geowit | Word | 7 | 03-08-2024 03:10 PM |
VBA Code to Save current Document as PDF and as DOCX | JohnTravolski | Word VBA | 2 | 02-03-2018 11:04 PM |
From a docx report document save all images in a cell from the document to a folder | censura | Word VBA | 1 | 05-13-2017 12:54 AM |
Word 2007 , when I save a .doc or .docx file the file type is showing "Empty" | Tomc29 | Word | 9 | 06-10-2015 03:04 AM |
How to save a macro in a document generated with a word model? | Cristin7 | Word VBA | 4 | 03-25-2014 03:25 AM |