I want to save a docx (Word 2007) as a html file with the accompanying files in a subfolder.
To see how to do that, I have just done that in Word 2007 and recorded a macro.
It recorded everything except the saving:
Sub Makro3()
With ActiveDocument.WebOptions
.RelyOnCSS = True
.OptimizeForBrowser = True
.OrganizeInFolder = True
.UseLongFileNames = True
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = msoScreenSize800x600
.PixelsPerInch = 96
.Encoding = 65001
End With
With Application.DefaultWebOptions
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = False
.CheckIfWordIsDefaultHTMLEditor = False
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
End Sub
As I want to do the same in VB6, I re-wrote the code replacing the enum as it was unavailable in VB6 and added a SaveAs line.
However, this saved the docx obviously as a docx again, just with a different extension (.html).
What am I doing wrong?
Public Sub pCreateHtml(ByVal uPath As String)
Dim oWord As New Word.Application
Set oWord = New Word.Application
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Open(uPath, True, True)
With oDoc.WebOptions
.RelyOnCSS = True
.OptimizeForBrowser = True
.OrganizeInFolder = True
.UseLongFileNames = True
.RelyOnVML = False
.AllowPNG = True
.ScreenSize = 3 'msoScreenSize800x600
.PixelsPerInch = 96
.encoding = 65001
End With
With oDoc.Application.DefaultWebOptions
.UpdateLinksOnSave = True
.CheckIfOfficeIsHTMLEditor = False
.CheckIfWordIsDefaultHTMLEditor = False
.AlwaysSaveInDefaultEncoding = False
.SaveNewWebPagesAsWebArchives = True
End With
oDoc.SaveAs Replace(uPath, ".docx", ".html")
oDoc.Saved = True
oDoc.Close
oWord.Quit
Set oWord = Nothing
End Sub
oDoc.SaveAs2 FileName:=Replace(uPath, ".docx", ".html"), FileFormat:=wdFormatHTML
//value of wdFormatHTML is 8
I have a simple vsto addin for word which allows me to select one or more pictures from disk then it inserts them into the current document. It works just fine and I have no problems with it. However, each time it inserts a picture word updates all fields in the document. Once the document has a hundred or so pictures this gets pretty time consuming. I need to turn off the auto updating of fields while these pictures are being inserted, then turn it back on when done.
What I have tried is this:
Adding this line at program start,
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = True
Adding these lines at program end,
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = False
Globals.ThisAddIn.Application.ActiveDocument.Fields.Update()
but word still updates ALL the fields in the document with each picture insertion. Is there some other method to accomplish this?
Thanks
Edit: this is the code that inserts the images
Sub ImportPictures()
Dim strPics As String = String.Empty
Dim arrPics() As String
Dim i As Long
Dim vrtSelectedItem As Object = Nothing
Dim tek As Microsoft.Office.Interop.Word.InlineShape = Nothing
Dim picName As String = String.Empty
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = True
'Open up a file browser so user can choose the spreadsheet for the part
Try
Using OpenFileDialog1 As New OpenFileDialog()
OpenFileDialog1.InitialDirectory = "c:\\"
OpenFileDialog1.Filter = "Images (*.gif;*.jpg;*.jpeg;*.png;*.bmp)|*.gif;*.jpg;*.jpeg;*.png;*.bmp"
OpenFileDialog1.FilterIndex = 1
OpenFileDialog1.RestoreDirectory = True
OpenFileDialog1.Multiselect = True
If OpenFileDialog1.ShowDialog() = DialogResult.OK Then
For Each vrtSelectedItem In OpenFileDialog1.FileNames
strPics = strPics & "|" & vrtSelectedItem
Next vrtSelectedItem
strPics = Mid(strPics, 2)
arrPics = Split(strPics, "|")
System.Array.Sort(arrPics)
For i = 0 To UBound(arrPics)
picName = Right(arrPics(i), Len(arrPics(i)) - InStrRev(arrPics(i), "\"))
tek.LockAspectRatio = True
tek.ScaleHeight = 32.3
tek.Select()
Globals.ThisAddIn.Application.ActiveDocument.Paragraphs.Format.Alignment = Microsoft.Office.Interop.Word.WdParagraphAlignment.wdAlignParagraphCenter
Globals.ThisAddIn.Application.Selection.InsertCaption(Label:="Figure", Title:=": " & picName, Position:=word.WdCaptionPosition.wdCaptionPositionBelow)
Globals.ThisAddIn.Application.Selection.Collapse(word.WdCollapseDirection.wdCollapseEnd)
Globals.ThisAddIn.Application.Selection.TypeParagraph()
Next i
Else
MsgBox("User pressed Cancel.")
End If
End Using
Globals.ThisAddIn.Application.ActiveDocument.Fields.Locked = False
Globals.ThisAddIn.Application.ActiveDocument.Fields.Update()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.SystemModal, "Error")
End Try
End Sub
ActiveDocument.Fields.Locked can only affect fields that exist in the document when that code line is executed. Unless you loop through all story ranges, it will also only affect fields in the document body. If you add another field whose property is 'hot' (see https://support.microsoft.com/en-us/topic/which-fields-are-updated-when-you-open-repaginate-or-print-document-e9580e16-7239-5263-83a4-061a27210076), it will update as soon as you insert it. Running ActiveDocument.Fields.Locked again will only prevent further updates.
Set obj = CreateObject("Excel.Application")
obj.Visible = False
Set objwbk = obj.Workbooks.Open("File Link")
obj.DisplayAlerts = False
objwbk.SaveAs "C:\Data.xlsx"
Set obj1 = obj.Workbooks.Open("C:\Data.xlsx")
obj1.Visible = True
I have the above code to create a copy of the file on SharePoint. I am able to open the file but it does not make a copy because the file is opened in readonly mode. I am unable to figure out how to use the ActiveProtectedWindow.edit method here to be able to successfully achieve my objective.
Maybe something like this:
Set obj = CreateObject("Excel.Application")
obj.Visible = False
obj.DisplayAlerts = False
Set objwbk = obj.Workbooks.Open("File Link")
If objwbk.Application.ProtectedViewWindows.Count > 0 Then
objwbk.Application.ActiveProtectedViewWindow.Edit
End If
objwbk.SaveAs "C:\Data.xlsx"
Set obj1 = obj.Workbooks.Open("C:\Data.xlsx")
obj1.Visible = True
I really some help! Here's a link to a google drive zip of the access database that I'm struggling with.
https://drive.google.com/file/d/0BwjnhQS2X7_Qamt4clFLc1Ztb2c/view?usp=sharing
So, what I have is an access database made up of a few tables and a form and some sub forms. The database info gets inputted to the tables via a form that I've created. In the example, the form is called "Database". This form exports to a word document, fields on the database go to bookmarks on the word doc. This works great so far.
In the attachment there is a "template" folder with the original word document, when the code runs it saves the completed form to the "generated" folder - works like a charm. Its a very long form for applications for liquor licenses.
So you fill in the form in access, it saves to the tables and exports the data to the word template document.
The problem that I have is that there is a subform on tab8 of the form where "director details" are saved. There can be any number of directors per application. I've managed to access the data on the subform's table, but have no idea how to loop through the data in that table to get all the information that is applicable to that application only and not data related to other applications. There is a relationship between the director details table and the application details table(this is the main table) and I'm using an application identifier field that I've created called and "ACNumber" which is unique to each application. There is a combobox on the form that selects the application and the form and subforms bring up the correct data when you select it.
The other part of the problem is how do I output this to word? A bookmark won't work, because all the fields are being repeated. Is there a way that all the data entries can be outputted to a single bookmark mabe in a textbox with the labels?
This is how it looks on the word document form:
(First person)
Full name : generate from item 5.4(a) from database
Physical address : generate from item 5.4(b) from database
Postal code : generate from item 5.4(c) from database
Postal address : generate from item 5.4(d) from database
Postal code : generate from item 5.4(e) from database
Identity number : generate from item 5.4(f) from database
(More person’s to add if needed)
Ok, I hope that describes my problem accurately.
I've tried all sorts to get this working, but its beyond me, please help guys!!!
Below is the code that I'm using: (the loop for the subform doesn't work, but one entry from that table is exported to the bookmarks currently in place)
I've tried all sorts to get this working, but its beyond me, please help guys!!!
`Private Sub ExportToWord_Click()
'Print customer slip for current customer.
Dim appWord As Word.Application
Dim doc As Word.Document
Dim drst As Recordset
Set drst = CurrentDb.OpenRecordset(Name:="62 Other Interests", Type:=RecordsetTypeEnum.dbOpenDynaset)
'Avoid error 429, when Word isnt open.
On Error Resume Next
Err.Clear
'Set appWord object variable to running instance of Word.
Set appWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
'If Word isnt open, create a new instance of Word.
Set appWord = New Word.Application
End If
Set doc = appWord.Documents.Open("C:\forms\templates\Form 3 - Sec 36(1).docx", , True)
With doc
.Bookmarks("wAppTradingNames").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wCompanyName").Range.Text = Nz(Me!CompanyName, "")
.Bookmarks("wCompanyNumber").Range.Text = Nz(Me!CompanyNumber, "")
.Bookmarks("wRAddress1").Range.Text = Nz(Me!RAddress1, "")
.Bookmarks("wPostalCode").Range.Text = Nz(Me!PostalCode, "")
.Bookmarks("wRPostalAddress1").Range.Text = Nz(Me!RPostalAddress1, "")
.Bookmarks("wRPostalCode").Range.Text = Nz(Me!RPostalCode, "")
.Bookmarks("wDomicilium1").Range.Text = Nz(Me!Domicilium1, "")
.Bookmarks("wDomiciliumCode").Range.Text = Nz(Me!DomiciliumCode, "")
.Bookmarks("wDomAfter1").Range.Text = Nz(Me!DomAfter1, "")
.Bookmarks("wDomAfterCode").Range.Text = Nz(Me!DomAfterCode, "")
.Bookmarks("wTelOffice").Range.Text = Nz(Me!TelOffice, "")
.Bookmarks("wTelCell").Range.Text = Nz(Me!TelCell, "")
.Bookmarks("wTelHome").Range.Text = Nz(Me!TelHome, "")
.Bookmarks("wFaxNumber").Range.Text = Nz(Me!FaxNumber, "")
.Bookmarks("wEmail").Range.Text = Nz(Me!Email, "")
.Bookmarks("wFIP").Range.Text = Nz(Me!FIP, "")
.Bookmarks("wAppLicCat").Range.Text = Nz(Me!AppLicCat, "")
.Bookmarks("wLiqourType").Range.Text = Nz(Me!LiqourType, "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wAppTradingName").Range.Text = Nz(Me!AppTradingName, "")
.Bookmarks("wLPAddress").Range.Text = Nz(Me!LPAddress, "")
.Bookmarks("wErfNumber").Range.Text = Nz(Me!ErfNumber, "")
.Bookmarks("wLPPostalCode").Range.Text = Nz(Me!LPPostalCode, "")
.Bookmarks("wLPOwnership").Range.Text = Nz(Me!LPOwnership, "")
.Bookmarks("wLPOwnersName").Range.Text = Nz(Me!LpOwnersName, "")
.Bookmarks("wLpOwnerAddress").Range.Text = Nz(Me!LpOwnerAddress, "")
.Bookmarks("wLpRightOccupation").Range.Text = Nz(Me!LpRightOccupation, "")
.Bookmarks("wLPOccDuration").Range.Text = Nz(Me!LPOccDuration, "")
.Bookmarks("wLpPremNotErected").Range.Text = Nz(Me!LpPremNotErected, "")
.Bookmarks("wLpPremAlterReq").Range.Text = Nz(Me!LpPremAlterReq, "")
.Bookmarks("wLpPremAllGood").Range.Text = Nz(Me!LpPremAllGood, "")
.Bookmarks("wLpBuildCommence").Range.Text = Nz(Me!LpBuildCommence, "")
.Bookmarks("wLpBuildDuration").Range.Text = Nz(Me!LpBuildDuration, "")
.Bookmarks("wLpTradingHours").Range.Text = Nz(Me!LpTradingHours, "")
.Bookmarks("wLpRenewal").Range.Text = Nz(Me!LpRenewal, "")
.Bookmarks("wLpJobsa").Range.Text = Nz(Me!LpJobsa, "")
.Bookmarks("wLpJobsB").Range.Text = Nz(Me!LpJobsB, "")
.Bookmarks("wLpJobsC").Range.Text = Nz(Me!LpJobsC, "")
.Bookmarks("wNNPRegName").Range.Text = Nz(Me!NNPRegName, "")
.Bookmarks("wNNPRegNumber").Range.Text = Nz(Me!NNPRegNumber, "")
.Bookmarks("wNNPRegDate").Range.Text = Nz(Me!NNPRegDate, "")
.Bookmarks("wOtherInterests").Range.Text = Nz(drst!OtherInterests, "")
.Visible = True
.Activate
End With
Dim rst As Recordset: Set rst = CurrentDb.OpenRecordset(Name:="5 Director Details", Type:=RecordsetTypeEnum.dbOpenDynaset)
'Do While Not rst.EOF
With doc
.Bookmarks("wPersonLabel").Range.Text = Nz(rst!PersonLabel, "")
.Bookmarks("wFullName").Range.Text = Nz(rst!FullName, "")
.Bookmarks("wPhAddress").Range.Text = Nz(rst!PhAddress, "")
.Bookmarks("wPhCode").Range.Text = Nz(rst!PhCode, "")
.Bookmarks("wPAddress").Range.Text = Nz(rst!PAddress, "")
.Bookmarks("wPCode").Range.Text = Nz(rst!PCode, "")
.Bookmarks("wIdNumber").Range.Text = Nz(rst!IdNumber, "")
.Visible = True
.Activate
rst.MoveNext
End With
'Loop
doc.SaveAs2 "C:\forms\generated\" & Me!ACNumber & "_Form 3 - Sec 36(1).docx"
Set doc = Nothing
Set appWord = Nothing
Exit Sub
errHandler:
MsgBox Err.Number & ": " & Err.Description
End Sub
`
This will point you to the right direction. You need to make a couple of changes though to fit your needs e.g. insert all your bookmarks, update the SQL strings and recordset fields.
You also need to make a few changes to your Word document though:
1) Add a table to hold the manager data (loop). Hide the borders if needed.
2) Save the document as Word Template (.dotx)
Public Sub ExportToWord()
On Error GoTo ErrorTrap
Const TemplatePath As String = "C:\forms\templates\Form 3 - Sec 36(1).dotx"
'Data
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)
'SaveAs
Dim name_ As String
name_ = "C:\forms\generated\" & rs![FieldName] & "_Form 3 - Sec 36(1).docx"
'Word
Dim oWord As Word.Application
Set oWord = New Word.Application
oWord.Visible = False
Dim oDoc As Word.Document
Set oDoc = oWord.Documents.Add(TemplatePath)
With oDoc
.Bookmarks("Bookmark_1").Range.Text = rs![FieldName_1]
.Bookmarks("Bookmark_2").Range.Text = rs![FieldName_2]
.Bookmarks("Bookmark_3").Range.Text = rs![FieldName_3]
'...
End With
rs.Close
Set rs = Nothing
'Loop data
Set rs = CurrentDb().OpenRecordset("SELECT * FROM TableName WHERE [Criteria]", dbOpenSnapshot)
With rs
If Not .EOF Then
.MoveLast
.MoveFirst
End If
End With
Dim idx As Integer
For idx = 1 To rs.RecordCount
With oDoc.Tables(1)
.Cell(idx, 1).Range.Text = rs![FieldName_1] '1st Column
.Cell(idx, 2).Range.Text = rs![FieldName_2] '2nd Column
.Cell(idx, 3).Range.Text = rs![FieldName_1] '3rd Column
'...
'add extra rows if required
If rs.AbsolutePosition <> rs.RecordCount - 1 Then .Columns(1).Cells.Add
End With
rs.MoveNext
Next idx
'Save
With oDoc
.SaveAs FileName:=name_, FileFormat:=Word.WdSaveFormat.wdFormatXMLDocument
.Close SaveChanges:=wdDoNotSaveChanges
End With
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
oWord.Quit
Set oWord = Nothing
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical, "ExportToWord()"
Resume Leave
End Sub
I'm brand spanking new to VBA. But I've programmed a bit in SAS, just a bit in Assembler (mainframe and PC), Word Perfect (macros), a bit in Java, HTML, other stuff. What I do is, when I have a problem and I think I can program it, I look for code on the internet and adjust it to fit my needs. I have read a little bit of VBA programming. What I'm trying to do is make a macro to save a bunch of Outlook e-mail messages with PDFMAKER. I've come up with the below, so far. When I step the program, pmkr2 gets assigned type "ObjectPDFMaker" and stng gets assigned type "ISettings". So far, so good. Then I try to set stng and can't do it. I get the error "Method or data member not found." If I get rid of Set it highlights .ISettings and I get the same error. I go into F2 and the AdobePDFMakerforOffice library is there, and the class ISettings is there, but I can't seem to set stng. I'm wa-a-a-ay frustrated. Please help.
Sub ConvertToPDFWithLinks()
Dim pmkr2 As Object
Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
Set stng = AdobePDFMakerForOffice.ISettings
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr.GetCurrentConversionSettings stng
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
I updated your code a little. See if this has any affect:
Sub ConvertToPDFWithLinks()
Dim pmkr2 As AdobePDFMakerForOffice.PDFMaker
'Set pmkr2 = Application.COMAddIns.Item(6).Object ' Assign object reference.
Set pmkr2 = Nothing
For Each a In Application.COMAddIns
If InStr(UCase(a.Description), "PDFMAKER") > 0 Then
Set pmkr2 = a.Object
Exit For
End If
Next
If pmkr2 Is Nothing Then
MsgBox "Cannot Find PDFMaker add-in", vbOKOnly, ""
Exit Sub
End If
Dim pdfname As String
pdfname = "C:\stuff\stuff\tester.pdf"
Dim stng As AdobePDFMakerForOffice.ISettings
pmkr2.GetCurrentConversionSettings stng
stng.AddBookmarks = True
stng.AddLinks = True
stng.AddTags = True
stng.ConvertAllPages = True
stng.CreateFootnoteLinks = True
stng.CreateXrefLinks = True
stng.OutputPDFFileName = pdfname
stng.PromptForPDFFilename = False
stng.ShouldShowProgressDialog = True
stng.ViewPDFFile = False
pmkr2.CreatePDFEx stng, 0
Set pmkr2 = Nothing ' Discontinue association.
End Sub
The main changes were in how the addin is obtained and in how stng is created.