Sub MyTemplate()
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Dim wordMailMerge As Word.MailMerge
Dim wordPath As String
Dim excelPath As String
CurrentWorksheet = ActiveSheet.Name
excelPath = ThisWorkbook.Path & "\Sticker Maker.xlsm"
wordPath = ThisWorkbook.Path & "\Inventory Labels.docx"
Set wordApp = CreateObject("Word.Application")
Set wordDoc = wordApp.Documents.Open(wordPath)
Set wordMailMerge = wordDoc.MailMerge
wordMailMerge.OpenDataSource Name:=excelPath, SQLStatement:="SELECT * FROM `'Barcode$'`"
wordMailMerge.Execute
'wordDoc.Close
wordApp.Visible = True
Set wordMailMerge = Nothing
Set wordDoc = Nothing
Set wordApp = Nothing
Sheets(CurrentWorksheet).Select
End Sub
The portion of this code that opens the excel file
wordMailMerge.OpenDataSource Name:=excelPath, SQLStatement:="SELECT * FROM 'Barcode$'"
throws an error because the file is already open. (that file is where the code is running) I just need it to assign the data from the workbook without opening it. because it will already be open running the macro.
Add the read only property when opening the file:
wordMailMerge.OpenDataSource Name:=excelPath, ReadOnly:=True, SQLStatement:="SELECT * FROM `'Barcode$'`"
Related
I have the following code that I'm going to build on to eventually ask the user whether they want to save a word document in a file location. But for the time being just testing out something really simple. The code however takes around 9-10 seconds to run. I appreciate the saving is happening on a network drive but even so the Word document is only 75kb big. Is there a quicker way of doing what I want to do?
Sub WordSaveAs()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdRng As Word.Range
Dim SaveName As String
Dim FileExt As String
Set wdApp = CreateObject("Word.Application")
With wdApp
Set wdDoc = .Documents.Open("[file location.docx]")
End With
SaveName = "[new file location.docx]" & FileExt
wdApp.DisplayAlerts = True
wdDoc.SaveAs SaveName
wdDoc.Close
Set wdDoc = Nothing
wdApp.Quit
Set wdApp = Nothing
End Sub
EDIT:
Thanks to #RaymondWu they have copied in a link below and i have used the following code instead:
Sub MoveFiles()
Dim FSO As Object
Dim SourceFileName As String, DestinFileName As String
Set FSO = CreateObject("Scripting.Filesystemobject")
SourceFileName = "file location.docx"
DestinFileName = "new file location.docx"
FSO.CopyFile Source:=SourceFileName, Destination:=DestinFileName
MsgBox (SourceFileName + " copied to " + DestinFileName)
End Sub
I am trying to convert a pdf file to an excel file (xlsx) using excel VBA.
The problem is the code seems to be perfectly fine as I have seen it working on other computers in action, but for some reason, I am getting a run time error and I am trying to solve this for a week.
Below is the code
Option Explicit
Function ClearCipboard()
'Early binding will requires a Reference to 'Microsoft Forms 2.0 Object Library'
Dim oData As Object 'New MSForms.DataObject
Set oData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
oData.SetText Text:=Empty
oData.PutInClipboard
Set oData = Nothing
End Function
Sub Automate()
Dim PathforPDFfiles As String
Dim PathforExcelfiles As String
PathforPDFfiles = "C:\Users\kvenkat2\Desktop\Trails 18.06.2021\Test File Excel\PDF-to-Excel-Converter\"
PathforExcelfiles = "C:\Users\kvenkat2\Desktop\Trails 18.06.2021\Test File Excel\PDF-to-Excel-Converter\"
Dim fso As New FileSystemObject
Dim myFolder As Folder
Dim myFile As File
Set myFolder = fso.GetFolder(PathforPDFfiles)
Dim WordApp As Object
Dim WordDoc As Object
Dim WordRange As Object
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set WordApp = CreateObject("word.application")
'Set WordDoc = WordApp.documents.Add
'Set WordApp = New Word.Application
WordApp.Visible = True
Dim nwb As Workbook
Dim nsh As Worksheet
For Each myFile In myFolder.Files
Set WordDoc = WordApp.documents.Open(myFile.Path, False, Format:="PDF Files")
Set WordRange = WordDoc.Paragraphs(1).Range
WordRange.WholeStory
Set nwb = Workbooks.Add
Set nsh = nwb.Sheets(1)
WordRange.Copy
nsh.Paste
nwb.SaveAs (PathforExcelfiles & Replace(myFile.Name, ".pdf", ".xlsx"))
Application.CutCopyMode = False
Call ClearCipboard
WordDoc.Close True
nwb.Close True
Next
WordApp.Quit
Set WordDoc = Nothing
Set WordApp = Nothing
Application.displayAlters = True
Application.ScreenUpdating = False
MsgBox ("Done for real")
End Sub
Set WordDoc = WordApp.documents.Open(myFile.Path, False, Format:="PDF Files")
This is the part where my code stops running and I try to see the opened word and nothing happens from here. I am unable to get past this line.
It shows as a run time error as shown in the image
Good afternoon,
I am wondering how to open the Word file, which has some fixed part of the string in its name.
Prevously I was trying to open in under the fixed name:
VBA Excel problem with opening the Word file
Now, I am going a step further and want to make my file more flexible.
I tried the following code:
Sub Rams()
Dim appWD As Word.Application
Set appWD = New Word.Application
Dim docWD As Word.Document
Dim DocName As String
DocName = "*RAMS*"
Set docWD = appWD.Documents.Open(ActiveWorkbook.path & "\" DocName & ".docx.docm")
appWD.Visible = True
But the debugger sets, that it's the syntax error (some parenthesis is missing here, but I don't know where.
I also tried:
Sub Rams()
Dim appWD As Word.Application
Set appWD = New Word.Application
Dim docWD As Word.Document
Set docWD = appWD.Documents.Open(ActiveWorkbook.path & "\*RAMS*.docx.docm")
appWD.Visible = True
But I am getting pretty much similar error to the previous situation. Theoretically, I know, that these symbols mustn't be there, although I don't know how to write it properly.
UPDATE:
With reference to the hints in the comments I tried sth like this:
Sub Rams2()
Dim appWD As Word.Application
Dim iIndex As Integer
Dim strPath As String
Dim strFile As String
strPath = ActiveWorkbook.path
strFile = Dir(strPath & "*RAMS*.docx.docm")
Do While strFile <> ""
Set wb = Workbooks.Open(filename:=strPath & strFile)
For iIndex = 1 To wb.Worksheets.Count
Set ws = wb.Worksheets(iIndex)
'Do something here.
Next Index
strFile = Dir 'This moves the value of strFile to the next file.
Loop
Set appWD = New Word.Application
Dim docWD As Word.Document
appWD.Visible = True
End Sub
NEXT UPDATE:
I found some solutions here:
https://www.techonthenet.com/excel/formulas/dir.php
and here
https://www.exceltrick.com/formulas_macros/vba-dir-function/
and finally used the following code:
Sub Rams3()
path = ActiveWorkbook.path & "\RAMS*.docm"
File = Dir(path)
Dim appWD As Word.Application
Set appWD = New Word.Application
Dim docWD As Word.Document
If Len(File) > 0 Then
Set docWD = appWD.Documents.Open(File)
appWD.Visible = True
Else
MsgBox ("File Doesn't Exist")
End If
End Sub
Basically the DIR function works correctly as well as the file opening command, but I don't know, why the path is redirected to WINDOWS/System32/ whereas I set the path for my workbook?
Only Word application is being opened without any documents...
I am trying to open a word document from excel and then save as to a new file location using a dialog box.
The problem is it saves the excel file rather than the word file that was opened.
Option Explicit
Sub SaveWordDoc()
Dim WordApp As Object, WordDoc As Object, path As String
Dim dlgSaveAs As FileDialog
' Allows word document to be selected and opened
With Application.FileDialog(msoFileDialogOpen)
.Show
If .SelectedItems.Count = 1 Then
path = .SelectedItems(1)
End If
End With
If path = "" Then
Exit Sub
End If
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(path)
WordApp.Visible = False
'Opens Save As dialog box
Set dlgSaveAs = Application.FileDialog( _
FileDialogType:=msoFileDialogSaveAs)
dlgSaveAs.Show
WordApp.ActiveDocument.Close
WordApp.Quit
Set WordApp = Nothing
Set WordDoc = Nothing
End Sub
Thank you BigBen your suggestion works well as long as the a word document format is selected.
Option Explicit
Sub Test()
Dim WordApp As Object, WordDoc As Object, path As String
Dim dlgSaveAs As FileDialog, fileSaveName As Variant
' To get the code to function I had to include the Microsoft Word 16 Object
'Library.
'From the excel VBA editor window. Tools > References then ensure Microsoft Word
'16.0 Object Library is checked.
' Allows word document to be selected and opened
With Application.FileDialog(msoFileDialogOpen)
.Show
If .SelectedItems.Count = 1 Then
path = .SelectedItems(1)
End If
End With
If path = "" Then
Exit Sub
End If
Set WordApp = CreateObject("Word.Application")
Set WordDoc = WordApp.Documents.Open(path)
WordApp.Visible = False
' Allows word document to be saved under a different file location and name
fileSaveName = Application.GetSaveAsFilename( _
fileFilter:="Word Documents (*.docx), *.docx")
WordApp.ActiveDocument.SaveAs2 Filename:=fileSaveName, _
FileFormat:=wdFormatDocumentDefault
WordApp.ActiveDocument.Close
WordApp.Quit
Set WordApp = Nothing
Set WordDoc = Nothing
End Sub
I need to have a vb code in ms word 2003 that copy a a specific cell in excel file and paste it in word (filed). Below is what I have done and it result in error.
Sub cmdGetNumber()
Dim XL As Object
Dim WBEx As Object
Dim ExelWS As Object
Dim appwd As Object
Dim wdApp As Word.Application
''''
'On Error GoTo OLE_ERROR
Set XL = CreateObject("Excel.Application")
Set wdApp = CreateObject("Word.Application")
'Open Excel document
Set WBEx = XL.Workbooks.Open("C:\Documents and Settings\121567\Desktop\tafket1.xls")
Set ExelWS = WBEx.Worksheets("Sheet1")
XL.Visible = True
'appwd.Visible = True
ExelWS.Range("c2").Select
'Selection.Copy
'wdApp.Selection.PasteSpecial Placement:=wdInLine, DataType:=wdPasteMetafilePicture
'wdApp.Documents.Save
Set wdApp = Nothing
Set ExelWS = Nothing
Set WBEx = Nothing
End Sub
Since this macro is in Word, you don't need to explicitly open a word instance. You can just do Documents.Add to add a new document, or Documents.Open to open an existing one.
Try this:
Sub cmdGetNumber()
Dim XL As Object
Dim WBEx As Object
Dim ExelWS As Object
Dim wdDoc As Word.Document
'On Error GoTo OLE_ERROR
Set XL = CreateObject("Excel.Application")
'Open Excel document
Set WBEx = XL.Workbooks.Open("C:\Documents and Settings\121567\Desktop\tafket1.xls")
Set ExelWS = WBEx.Worksheets("Sheet1")
'XL.Visible = True
ExelWS.Range("C2").Copy
Set wdDoc = Documents.Add
wdDoc.Activate
wdDoc.Select
Selection.Paste
WBEx.Close
XL.Quit
Set WBEx = Nothing
Set ExelWS = Nothing
Set XL = Nothing
End Sub
The above code will open your excel file, copy the cell C2, then open a new word document, and paste it there.
I see you have mentioned a (filed) in your question. Did you mean a Field or a File? If it is a Field then you may want to replace Selection.Paste with the relevant field name