The following code is intended to update Word bookmarks with formatted data from Excel, however the formatting doesn't come across and unsure why, would appreciate any suggestions. The formatted data is text with certain works underlined.
Set wb = ActiveWorkbook
TodayDate = Format(Date, "mmmm d, yyyy")
Path = wb.Path & "\update_file.docx"
'Create a new Word Session
Set pappWord = CreateObject("Word.Application")
'Open document in word
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName).Text
End If
Next xlName
Try this instead, using Copy and the (poorly-documented) ExecuteMso method. You need to use Copy against the range (in order to capture formatting) and then you can effectively do the same as the right-click Paste + Keep Source Formatting option:
If docWord.Bookmarks.Exists(xlName.Name) Then
xlName.RefersToRange.Copy
docWord.Bookmarks(xlName.Name).Select
docWord.Application.CommandBars.ExecuteMso "PasteSourceFormatting"
End If
Alternatively, and this might be better because ExecuteMso is asynchronous and can result in timing issues:
xlName.RefersToRange.Copy
docWord.Bookmarks(xlName.Name).Range.PasteAndFormat 16 'wdFormatOriginalFormatting
Related
I am trying to copy a bunch of text data from an excel spreadsheet into multiple separate word documents (one excel row = one document, but each column's heading has to be included before the text from the respective field of the row). I also want these documents' names to be the text from specific fields in the spreadsheet (row headers).
Because I want fancy formatting, and a specific order of copying/pasting things (not all fields are included), I am using a word template with bookmarks that I can feed into VBA. It fills the template well, but I cannot save it as a standard word document before repeating the loop. I get the error 'Object doesn't support this property or method'. Is there a way to overcome it, or a more elegant method I've missed?
Here is the code:
Sub Primitive()
Dim objWord As Object
Dim ws As Worksheet
Dim i As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
i = 2 ' First row to process
'Start of loop
Do Until ws.Range("B" & i) = ""
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
'Change to local path of template file
objWord.Documents.Open "C:path of template file.dotx"
With objWord.ActiveDocument
.Bookmarks("FirstBookmark").Range.Text = ws.Range("B" & i).Value & " " & ws.Range("C" & i)
.Bookmarks("headlineZ").Range.Text = ws.Range("Z1").Value
lots of this^ here to arrange the data right in the document
NewFileName = "C:\path of where I want the new file" & ws.Range("C" & i).Value & ".docx"
This is the line that gives the error 483:
objWord.SaveAs2 Filename:="NewFileName"
End With
objWord.Close
Set objWord = Nothing
i = i + 1
Loop
End Sub
You are trying to save Word, rather than the document. If you replace this
objWord.SaveAs2 Filename:="NewFileName"
with this
objWord.ActiveDocument.SaveAs2 Filename:="NewFileName"
it should work better. That said, you should not use ActiveDocument in your macros. Consider replacing
objWord.Documents.Open "C:path of template file.dotx"
with something like
Set TargetDocument = objWord.Documents.Open("C:path of template file.dotx")
and replace all ActiveDocument with TargetDocument.
Currently I am copying an active excel sheet and saving the data from this active excel spreadsheet to a pre-formatted word document.
This pre-formatted word document then gets saved with a specific file name.
In the initial VBA setup i have declared a variable called myfilename which contains a date value. (01022019)
What I would like to learn is how I can concatenate the myfilename value with the saved filename using the SaveAs command as shown in the code. For example the saved file would be test 01022019. This is a straightforward task when saving an Excel Spreadsheet using VBA but not so when saving a word document using VBA.
I have attached some code in the hope I can get a solution:
Sub SaveAsWord()
Dim LastRow As Long
Dim objWord, objDoc As Object
Dim myfilename As String
myfilename = Sheets("Import").Range("B2")
Set wordApp = CreateObject("word.Application")
wordApp.Documents.Open "C:\test\test\worddocument.docx"
wordApp.Visible = True
With wDoc
wordApp.ActiveDocument.SaveAs Filename:="C:\test\test.docx"
End With
End Sub
You need to use & to conctenate the path(String) and the filename (Variable) as shown below. Also you need to specify the FileFormat.
Try this
wordApp.ActiveDocument.SaveAs2 Filename:="C:\test\test\" & myfilename & ".docx", _
FileFormat:=wdFormatXMLDocument
or
wordApp.ActiveDocument.SaveAs2 Filename:="C:\test\test" & myfilename & ".docx", _
FileFormat:=wdFormatXMLDocument
Choose one from above based on the location where you want to save it.
If you are late binding then then declare this at the very top.
Const wdFormatXMLDocument as Integer = 12
In my excel document I have a chart that I want to copy and paste into a MS-Word document. I want to avoid linking data, embedding workbooks and resizing (Excel has the chart formatted to my desired size). So I came up with/found the following code that almost works:
Sub PasteChart()
Dim wd As Object
Dim ObjDoc As Object
Dim FilePath As String
Dim FileName As String
FilePath = "C:\Users\name\Desktop"
FileName = "Template.docx"
'check if template document is open in Word, otherwise open it
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
Else
On Error GoTo notOpen
Set ObjDoc = wd.Documents(FileName)
GoTo OpenAlready
notOpen:
Set ObjDoc = wd.Documents.Open(FilePath & "\" & FileName)
End If
OpenAlready:
On Error GoTo 0
'find Bookmark in template doc
wd.Visible = True
ObjDoc.Bookmarks("LPPU").Select
'copy chart from Excel
Sheets("Group Level Graphs").ChartObjects("Chart 1").Chart.ChartArea.Copy
'insert chart to Bookmark in template doc
wd.Selection.PasteSpecial Link:=False, DataType:=14, Placement:=0, _
DisplayAsIcon:=False
End Sub
The only issue is that the image is pasted as "In Line with Text" but I need it to be "Square with text wrapping". I can't get Word or Excel to record changing the image to "Square with text wrapping".
The PasteSpecial part only does wdFloatOverText or wdInLine for placement and neither of them solve this issue.
I am very new to VBA and have run out of ideas. I am still trying to find a way to format it, maybe using some kind of WITH statement. However I thought I would attempt to reach out for help while I continue google-foo and learning VBA from Youtube.
Using PasteAndFormat Type:=wdChartPicture links the chart to excel. So that didn't work.
Make sure you have a reference to the Word application in your VBE then immediately following a regular paste (wd.Selection.Paste), add these two lines of code:
wd.Selection.MoveStart word.WdUnits.wdCharacter, Count:=-1
wd.Selection.InlineShapes(1).ConvertToShape.WrapFormat.Type = wdWrapSquare
If you want to continue to use the PasteSpecial method you have in your code then replace the code line above "wd.Selection.MoveStart..." to this:
wd.Selection.MoveEnd word.WdUnits.wdCharacter, Count:=1
The reason is a regular paste leaves the active insertion point at the end of the inserted object. But if a PasteSpecial method is used the active insertion point is at the beginning of the object that was pasted. Why? I have no idea! Word VBA never ceases to amaze me. :-)
I have about 50 or so Excel workbooks that I need to pull data from. I need to take data from specific cells, specific worksheets and compile into one dataset (preferably into another excel workbook).
I am looking for some VBA so that I can compile the results into the workbook I am using to run the code.
So, one of the xls or xlsx files I need to pull the data from, worksheet("DataSource"), I need to evaluate cell(D4), and if its not null, then pull data from cell(F4), and put into a new row into the compiled data set. Looping through all the Excel files in that folder as mentioned above.
And if possible, I would like the first data field in the first column the name of the file the data is being pulled from in the resulting dataset.
Can someone help me with this? I am looking for VBA because I am more familiar with that, but also interested in VBScript (as I am trying to get into that and learn the differences).
First start with this google query and click the first link that comes up, which takes you to an article showing how to iterate through a group of Excel files in a folder.
Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
'Change path to suit
.LookIn = "C:\MyDocuments\TestResults"
.FileType = msoFileTypeExcelWorkbooks
'Optional filter with wildcard
'.Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all
'Open Workbook x and Set a Workbook variable to it
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=False
Next lCount
End If
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
To get the name of the workbook, you'll want to adapt the code at "DO YOUR CODE HERE" to include wbResults.Name. If it's the filename you want, use wbResults.FullName, which returns the name of the workbook including its path on disk as a string.
A search for a VBScript variation on the same thing yields a number of results that are useful, including this script:
strPath = "C:\PATH_TO_YOUR_FOLDER"
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)
For Each objFile In objFolder.Files
If objFso.GetExtensionName (objFile.Path) = "xls" Then
Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
' Include your code to work with the Excel object here
objWorkbook.Close True 'Save changes
End If
Next
objExcel.Quit
I would do it in VBScript or even, VB.NET or Powershell if you feel so inclined.
Using VB.NET, you can access Excel spreadsheets as if they were databases, via the OLEDB provider. The code to select a range of values might look like this :
Try
Dim MyConnection As System.Data.OleDb.OleDbConnection
Dim DtSet As System.Data.DataSet
Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
MyConnection = New System.Data.OleDb.OleDbConnection _
("provider=Microsoft.Jet.OLEDB.4.0;" _
" Data Source='testfile.xls'; " _
"Extended Properties=Excel 8.0;")
MyCommand = New System.Data.OleDb.OleDbDataAdapter _
("select * from [Sheet1$]", MyConnection)
MyCommand.TableMappings.Add("Table", "TestTable")
DtSet = New System.Data.DataSet
MyCommand.Fill(DtSet)
MyConnection.Close()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
Once you get the data you can elaborate on it, then insert the result into another Excel spreadsheet, using the same API.
Getting the list of files is easy in .NET with a call to System.IO.Directory.GetFiles(); just specify the "*.xls" wildcard. Once you have the list, just use a for loop to iterate through it, opening each file in turn, then doing the query on that file, and so on.
If you use VBScript, then the preferred way to get the list of Excel files is to use the Scripting.FileSystemObject, specifically the GetFolder method. It works basically the same way but the syntax is slightly different.
If it's VBScript or VB.NET it will probably run outside of Excel itself. You'd run it by double-clicking or from a batch file or something like that. The advantage to using VB.NET is you could put up a graphical form for interaction - it could show a progress bar, tracking how many files you've gone through, status updates, that kind of thing.
Whenever you are accessing that many Excel files in succession, you can generally get better performance using ADODB rather than Excel's automation object.
I agree with using that accessing the Excel object is not the quickest and if the workbooks and sheets that you're trying to retrieve data from are all consistent (i.e have the same column names, etc... or at least the column names you're looking for) it would be better to use ODBC. This does have some issues and if you can't get around them or need to actually do something more complex based on the contents then there may be no way around it. If that's the case then I would suggest creating one Excel object and then opening and closing the files as needed to try to increase the efficiency.
It could be done with the following code
Sub LoopThroughFiles()
Dim StrFile As String
StrFile = Dir("V:\XX\XXX\*.xlsx")
Do While Len(StrFile) > 0
Debug.Print StrFile
Set wbResults = Workbooks.Open("V:\XX\XXX\" & StrFile)
'DO YOUR CODE HERE
wbResults.Close SaveChanges:=True
StrFile = Dir
Loop
End Sub
I need to export data in a sheet to a text file without changing the file name (i.e. not doing "save as". Also it would be great if the file name could look at the previous like file name in the folder and increase by 1 digit (i.e. :file_1.txt, file_2.txt, etc.)...
Thanks!!
If you want to avoid the current name of your excel file being changed, just save the current worksheet, not the whole workbook (the VBA equivalent of the SaveAs function is ActiveWorkbook.SaveAS, to save just the current sheet use ActiveSheet.SaveAS).
You can use the following macro:
Sub Macro1()
Application.DisplayAlerts = False
ActiveSheet.SaveAs Filename:="NewFile.txt", FileFormat:=xlTextWindows
Application.DisplayAlerts = True
End Sub
Toggling the DisplayAlerts property avoids a message box that is displayed if the given file already exists.
If want to save more than one sheet, you need to iterate through the Sheets collection of the ActiveWorkbook object and save each sheet to a separate file.
You can get a new file name as illustrated below, it includes a date. If you would like to add some details on what you want to export, you may get a fuller answer.
Function NewFileName(ExportPath)
Dim fs As Object '' or As FileSytemObject if a reference to
'' Windows Script Host is added, in which case
'' the late binding can be removed.
Dim a As Boolean
Dim i As Integer
Dim NewFileTemp As string
Set fs = CreateObject("Scripting.FileSystemObject")
NewFileTemp = "CSV" & Format(Date(),"yyyymmdd") & ".csv"
a = fs.FileExists(ExportPath & NewFileTemp)
i = 1
Do While a
NewFileTemp = "CSV" & Format(Date(),"yyyymmdd") & "_" & i & ".csv"
a = fs.FileExists(ExportPath & NewFileTemp)
i = i + 1
If i > 9 Then
'' Nine seems enough times per day to be
'' exporting a table
NewFileTemp = ""
MsgBox "Too many attempts"
Exit Do
End If
Loop
NewFileName = NewFileTemp
End Function