I am making my first steps in VBA.
I have been trying many things, but still I haven't figured out a way to save a .pptm powerpoint presentation to .pptx format with the same file name in a specific path?
I already use the following code to save as pdf.
ActivePresentation.ExportAsFixedFormat "c:\" + Replace(ActivePresentation.Name, "pptm", "pdf"), ppFixedFormatTypePDF, ppFixedFormatIntentPrint, msoCTrue
Thank you in advance.
Basic usage is:
With ActivePresentation
.SaveCopyAs _
FileName:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
FileFormat:=ppSaveAsOpenXMLPresentation
End With
(Or you can use .SaveAs. SaveAsCopy keeps the current open and doesn't open the copy, whereas .SaveAs sets the current to be the saved version)
However, if the Powerpoint you are saving hasn't been saved at least once then the above will error (there is no file extension in Presentation.Name to find with InStrRev). You can either test for there being no full stop, or you can use a lazy method of asking FileSystemObject to get you the name without an extension (I am lazy so I prefer this method):
So a better more robust method is:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
With ActivePresentation
.SaveCopyAs _
FileName:=fso.BuildPath(.Path, fso.GetBaseName(.Name) & ".pptx"), _
FileFormat:=ppSaveAsOpenXMLPresentation
End With
Related
I need to loop over some word documents, and extract images from a word document and save them in a separate folder.
I've tried the method of saving them as an HTML document, but it is not a good fit for my requirement.
Now, I'm looping through the images using inlineshapes object and then copy-pasting them on a publisher document and then saving them as an image. However, I'm facing a Runtime Automation error when I'm running the script.
For using the Publisher runtime library I've tried both early and late binding but I'm facing the error on both of them.
Can anyone please let me know what is the problem? Also, if anyone can explain why I'm facing this error, that'd be great. As per my understanding, it is due to memory allocation, but I'm not sure.
Here is the code block that I've been working on (fp, dp are folder paths, while filename is the word document name. I'm calling this sub in another sub that is looping over all the files in a folder):
Sub test(ByVal fp As String, ByVal dp As String, ByVal filename As String)
Dim doc As Document
Dim pubdoc As New Publisher.Document
Dim shp As InlineShape
'Application.Screenupdating = False
'Dim pubdoc As Object
'Set pubdoc = CreateObject("Publisher.Document")
Set doc = Documents.Open(fp)
With doc
i = .InlineShapes.Count
Debug.Print i
End With
For j = 1 To i
Set shp = doc.InlineShapes(j)
shp.Select
Selection.CopyAsPicture
pubdoc.Pages(1).Shapes.Paste
pubdoc.Pages(1).Shapes(1).SaveAsPicture (dp & Application.PathSeparator & j & ".jpg")
pubdoc.Pages(1).Shapes(1).Delete
Next
doc.Close (wdDoNotSaveChanges)
pubdoc.Close
'Application.Screenupdating = True
End Sub
Apart from this, if anyone has any suggestions to make this faster, I'm all ears. Thanks in advance!
Just add .zip to the end of the file name, expand the file and look in the word/media folder. All the files will be there, no programming necessary.
Extracting the pictures from a Filtered HTML document that was created from your original source document would be faster. However, you said that was not a good fit for you needs so ... here is example code that will locate pictures in your source document and paste them into a second document.
The speed problem of this type of code is caused by the CopyPicture working from a Selection command, so I recommend using a range instead. Of course the For/Next loop that is required is slower no matter what.
Sub CopyPasteAsPicture()
Dim doc As Word.Document, iShp As Word.InlineShape, shp As Word.Shape
Dim i As Integer, nDoc As Word.Document, rng As Word.Range
Set doc = ActiveDocument
If doc.Shapes.Count > 0 Then
For i = 1 To doc.Shapes.Count
Set shp = doc.Shapes(i)
If shp.Type = msoLinkedPicture Or shp.Type = msoPicture Then
'if you want only pictures extracted then you have
'to specify the type
shp.ConvertToInlineShape
'if you want all extracted pictures to be in the sequence
'they appear in the document then you have to convert
'floating shapes to inline shapes
End If
Next
End If
If doc.Content.InlineShapes.Count > 0 Then
Set nDoc = Word.Documents.Add
Set rng = nDoc.Content
For i = 1 To doc.Content.InlineShapes.Count
doc.Content.InlineShapes(i).Range.CopyAsPicture
rng.Paste
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
rng.Paragraphs.Add
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
Next
End If
End Sub
If you want to place all shapes (floating or inline) into a folder as image files, then the best way is to save the source document as a filtered HTML document. Here is the command:
htmDoc.SaveAs2 FileName:=LGPWorking & strFileName, AddToRecentFiles:=False, FileFormat:=Word.WdSaveFormat.wdFormatFilteredHTML
In the above the active document is assigned to the variable htmDoc. I am giving this new document a specific name and location. The output from this is not only the HTML file but also a directory by the same name with an appended "_Files" label. In the "x_Files" directory are all the image files.
If you only want selective images pulled from your original source document, or if you want images pulled from multiple source documents ... then you need to use the above code that I shared for placing only the images you want from one or more source document into a new Word document and then save that new document as an Filtered HTML.
When your routine is done, you can Kill the HTML document and only leave the Files directory.
I had to change a few things around, but this will allow to save a single image on a word document and go through a couple of cycles before it turns into a jpg on the other side, without any white space
filename = ActiveDocument.FullName
saveLocaton = "z:\temp\"
FolderName = "test"
On Error Resume Next
Kill "z:\temp\test_files\*" 'Delete all files
RmDir "z:\temp\test_files" 'Delete folder
ActiveDocument.SaveAs2 filename:="z:\temp\test.html", FileFormat:=wdFormatHTML
ActiveDocument.Close
Kill saveLocaton & FolderName & ".html"
Kill saveLocaton & FolderName & "_files\*.xml"
Kill saveLocaton & FolderName & "_files\*.html"
Kill saveLocaton & FolderName & "_files\*.thmx"
Name saveLocaton & FolderName & "_files\image00" & 1 & ".png" As saveLocaton & FolderName & "_files\" & test2 & "_00" & x & ".jpg"
Word.Application.Visible = True
Word.Application.Activate
I have an MS Word document with macros (.docm)
Based on many StackOverflow posts, I've written a macro to export as a pdf and save as a .docx
I open/edit the .docm document, that has an onSave macro that saves the document in .pdf format and .docx format which I distribute for other people to use. I will always be making my changes to the .docm document.
My issue is that doing so converts the active(open) document from .docm to .docx such that I'm no longer making my changes to the .docm.
Sub SaveActiveDocumentAsDocx()
On Error GoTo Errhandler
If InStrRev(ActiveDocument.FullName, ".") <> 0 Then
Dim strPath As String
strPath = Left(ActiveDocument.FullName, InStrRev(ActiveDocument.FullName, ".") - 1) & ".docx"
ActiveDocument.SaveAs2 FileName:=strPath, FileFormat:=wdFormatDocumentDefault
End If
On Error GoTo 0
Exit Sub
Errhandler:
MsgBox "There was an error saving a copy of this document as DOCX. " & _
"Ensure that the DOCX is not open for viewing and that the destination path is writable. Error code: " & Err
End Sub
I can find no parameter to prevent this conversion of the active document in either "saveas" or "saveas2"
Furthermore, after the "saveas" command, any additional lines in the original macro are not executed because the active document no longer contains macros. I tried adding lines to the macro to reopen the original .docm and then close the .docx but those commends never execute.
I'm hoping I'm just missing something simple?
Sub SaveAMacrolessCopyOfActiveDocument()
' Charles Kenyon 2 October 2020
' Save a copy of active document as a macrofree document
'
Dim oDocument As Document
Dim oNewDocument As Document
Dim iLength As Long
Dim strName As String
Set oDocument = ActiveDocument ' - saves a copy of the active document
' Set oDocument = ThisDocument '- saves copy of code container rather than ActiveDocument
Let iLength = Len(oDocument.Name) - 5
Let strName = Left(oDocument.Name, iLength)
Set oNewDocument = Documents.Add(Template:=oDocument.FullName, DocumentType:=wdNewBlankDocument, Visible:=False)
oNewDocument.SaveAs2 FileName:=strName & ".docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
oNewDocument.Close SaveChanges:=False
' Clean up
Set oDocument = Nothing
Set oNewDocument = Nothing
End Sub
The above code creates and saves a copy of the ActiveDocument with the same name but as a .docx formatted document (macro-free). The visible property in the .Add command means that it will not appear on screen and it is closed by the procedure. The new document will appear in Recent documents.
I want to open and copy sheet in file TFM_20150224_084502 and this file has different date and time each day. I have developed code until open the date format but I can't develop to open it with time format.
What's the more code for it?
Sub OpenCopy ()
Dim directory As String, fileName As String, sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "z:\FY1415\FI\Weekly Report\Astry"
fileName = "TFM_" & Format(Date, "yyyymmdd") & ".xls"
Workbooks.Open "z:\FY1415\FI\Weekly Report\Astry\" & "TFM_" & Format(Date, "yyyymmdd") & ".xls"
Sheets("MSP").Copy After:=Workbooks("Generate Report 2.xlsm").Sheets("PlanOEE")
ActiveSheet.Name = "MSP"
End sub
It seems that some linebreaks have disappeared when you posted the code into your post, but assuming you are aware of this, I assume that the main problem you have is figuring out the name of the file you want to open?
The VBA Dir-function lets you search for a file in a folder, and lets you include wildcards in your search. I've included this function in your sub, and have tested it with a similarly named file on my computer (albeit without the copying of the sheet), and it opened the sheet:
Sub OpenCopy()
Dim directory As String, fileName As String, sheet As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "z:\FY1415\FI\Weekly Report\Astry\"
fileName = Dir(directory & "TFM_" & Format(Date, "yyyymmdd") & "*.xls*")
If fileName <> "" Then
With Workbooks.Open(directory & fileName)
.Sheets("MSP").Copy After:=Workbooks("Generate Report 2.xlsm").Sheets("PlanOEE")
End With
ActiveSheet.Name = "MSP"
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The line relevant for finding the filename is, as you probably see:
fileName = Dir(directory & "TFM_" & Format(Date, "yyyymmdd") & "*.xls*")
I have simply used Dir to do a search for file fitting the string inside the parantheses, where the asterisks are wildcards. The reason I have included an asterisk after xls too is because there is a chance the file can have extensions such as xlsx or xlsm in newer versions of office. I've also added a backslash at the end of the directory string, since you'll have to include it before the filename anyway.
I have also added an if-clause around what you do with the workbook you open, in case no file fitting the search is found.
Note that this sub will only do what you want provided that there only is one file generated for each date. If you want to loop through all files which includes a given date, I would recommend having a look at this post here on SO, which explains how to loop through all files in a folder, modifying the macros presented there to fit your needs should be fairly trivial.
I have Word survey files, each containing forms filled by subjects. Until now I have manually exported the forms data by saving as txt and choosing the option "save form data as delimited text file".
I want to programmatically save as delimited text file all the .doc documents in a given directory. Alternatively, if this were to be too complicated, it would be sufficient to save one file at a time. The new txt files must have the same name as the original .doc files.
Thanks for your input Jan Schejbal. I've reached a solution with this piece of code, so I share it for whose who encounter the same problem. I received help from here
Sub Save_Forms_Data()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document, strDocName As String
strFolder = CurDir
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
strDocName = Left(.FullName, InStrRev(.FullName, ".")) & "txt"
.SaveAs2 FileName:=strDocName, FileFormat:=wdFormatText, AddToRecentFiles:=False, _
SaveFormsData:=True, Encoding:=1252, InsertLineBreaks:=False, LineEnding:=wdCRLF
.Close SaveChanges:=False
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
Application.Quit SaveChanges:=wdDoNotSaveChanges
End Sub
You can record a macro, which means you start the recording, do certain actions, then stop the recording, and VBA code for said actions is automatically generated. The code may not be very clean, but it should give you a good start to show you how the syntax looks and what commands you need for your actions. For certain things (e.g. dynamically specifying the file name), you will need to consult the documentation, but if you have any programming experience in any common language, this should not pose a significant problem once you have the "skeleton" provided by the macro recorder.
The more you want to automate, the more VBA you will need to learn. As VBA really isn't difficult, and it seems like you have a lot of repetitive work in front of you if you don't automate it, I'd suggest you learn it and Google what you need. This way, you will get your work done in a similar timeframe (or less, especially if this is not just a one-off thing), you will have a macro to do it next time, it will be less boring, and you will have learned a bit of VBA.
I am working on an application for which i need to convert .docx and .pdf file to .txt
file with basic formatting. I searched it in internet but couldn't find any free third party dlls. Can any one suggest me best way and some dlls reference for this.
Thanks in Advance
http://support.microsoft.com/kb/316383 describes what you want to do with .docx files very well.
http://visualbasic.about.com/od/quicktips/qt/disppdf.htm describes the same, but with .pdf files.
Once you have read files into your code, output to a txt file using VB.NET's built in file writing functions.
The code below will handle the job for you. It is something I wrote for the big boss haha. I hope it helps. The code reads the first cell in the work sheet as the folder where docx files are present and then converts them to txt files one by one saving in the same folder.
Const wdFormatText = 2
If Not Len(Cells(1, "A").Value) > 0 Or Dir(Cells(1, "A").Value, vbDirectory) = "" Then
MsgBox ("Invalid Folder")
Exit Sub
End If
Dim StrFile As String
StrFile = Dir(Cells(1, "A").Value & "\*.docx")
Do While Len(StrFile) > 0
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(Cells(1, "A").Value & "\" & StrFile, False, True)
objDoc.SaveAs Cells(1, "A").Value & "\" & StrFile & ".txt", wdFormatText
objWord.Quit
StrFile = Dir
Loop