Mrrrr's Forum
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
Lista Forumurilor Pe Tematici
Mrrrr's Forum | Lista de useri | Inregistrare | Login

POZE MRRRR'S FORUM

Nu sunteti logat.
Nou pe simpatie:
miss2016
Femeie
24 ani
Ilfov
cauta Barbat
24 - 44 ani
Mrrrr's Forum / Tutoriale si Ghiduri Utile // Tutorials and useful guides / [WORD] Batch Convert DOC to DOCX, DOCX to DOC and DOC to PDF [VBA] Moderat de TonyTzu  
Autor
Mesaj Pagini: 1
TRaP
Membru activ

Inregistrat: acum 1 an
Postari: 331
Source:
https://gist.github.com/lizardking8610/ ... e093288a8c

Batch convert DOC to DOCX



Sub ConvertDocIntoDocx()
  Dim objWordApplication As New Word.Application
  Dim objWordDocument As Word.Document
  Dim strFile As String
  Dim strFolder As String

  strFolder = InputBox("Insert directory here")
 
  If Right(strFolder, 1) <> "\" Then
    strFolder = strFolder & "\"
  End If

  'strFolder = "D:\Temp\" '##### USE THIS LINE IF YOU WANT TO DEFINE THE DIRECTORY IN VBA
  strFile = Dir(strFolder & "*.doc", vbNormal)
 
  While strFile <> ""
    With objWordApplication     
      Set objWordDocument = .Documents.Open(FileName:=strFolder &strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
         
      With objWordDocument
        .SaveAs FileName:=strFolder & Replace(strFile, "doc", "docx"), FileFormat:=16
        .Close SaveChanges:=wdDoNotSaveChanges
      End With
    End With
    strFile = Dir()
  Wend   

  Set objWordDocument = Nothing
  Set objWordApplication = Nothing
End Sub


Batch convert DOCX to DOC



Sub ConvertDocxIntoDoc()
  Dim objWordApplication As New Word.Application
  Dim objWordDocument As Word.Document
  Dim strFile As String
  Dim strFolder As String

  strFolder = InputBox("Insert directory here")
 
  If Right(strFolder, 1) <> "\" Then
    strFolder = strFolder & "\"
  End If

  'strFolder = "D:\Temp\" '##### USE THIS LINE IF YOU WANT TO DEFINE THE DIRECTORY IN VBA
  strFile = Dir(strFolder & "*.docx", vbNormal)
   
  While strFile <> ""
    With objWordApplication 
      Set objWordDocument = .Documents.Open(FileName:=strFolder & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
     
      With objWordDocument
        .SaveAs FileName:=strFolder & Replace(strFile, "docx", "doc"), FileFormat:=0
        .Close SaveChanges:=wdDoNotSaveChanges
      End With
    End With
    strFile = Dir()
  Wend

  Set objWordDocument = Nothing
  Set objWordApplication = Nothing
End Sub


Modificat de TRaP (acum 4 luni)


pus acum 8 luni
   
TRaP
Membru activ

Inregistrat: acum 1 an
Postari: 331
Batch convert DOCX and DOC to PDF


Sub BulkConvertDocxAndDocToPDF()

    Dim oFileDlg As FileDialog
    Dim strFolder As String
    Dim strFileName As String
    Dim oDoc As Document
    Dim rsp As VbMsgBoxResult
   
    ' Tell user what's happening
    rsp = MsgBox( _
        Prompt:="Convert all documents in a folder to PDF format?" & _
            vbCr & "If yes, select the folder in the next dialog.", _
        Buttons:=vbYesNo + vbExclamation, _
        Title:="Bulk Convert to PDF")
    If rsp = vbYes Then
        ' Prepare and show folder picker dialog
        Set oFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
        With oFileDlg
            .Title = "Bulk Convert to PDF"
            .AllowMultiSelect = False
            ' Start in user's Documents folder
            .InitialFileName = Application.Options.DefaultFilePath(wdDocumentsPath)
            If .Show = -1 Then
                ' User clicked OK; get selected path
                strFolder = .SelectedItems(1) & "\"
            End If
        End With
        ' Remove dialog object from memory
        Set oFileDlg = Nothing
    End If
   
    If Not strFolder = "" Then
        strFileName = Dir(pathname:=strFolder & "*.doc*")
        WordBasic.DisableAutoMacros 1   'Disables auto macros
        Application.ScreenUpdating = False
       
        While strFileName <> ""
            ' Set an error handler
            On Error Resume Next
           
            ' Attempt to open the document
            Set oDoc = Documents.Open( _
                FileName:=strFolder & strFileName, _
                PasswordDocument:="?#nonsense@$")
           
            ' Check for error that indicates password protection
            Select Case Err.Number
                Case 0
                    ' Document successfully opened
                    ' Do nothing here
                Case 5408
                     ' Document is Password-protected and was NOT Opened
                    Debug.Print strFileName & " is password-protected " & _
                        "and was NOT processed."
                    ' Clear Error Object and Disable Error Handler
                    Err.Clear
                    On Error GoTo 0
                    ' Get Next Document
                    GoTo GetNextDoc
   
                Case Else
                    ' Another Error Occurred
                    MsgBox "Error " & Err.Number & vbCr & Err.Description
            End Select
           
            ' Change extension from .docX* to .pdf
            strFileName = Replace(strFileName, ".doc", ".pdf") 'Replace(LCase(strFileName), ".doc", ".pdf")
            If Right(strFileName, 1) = "x" Or Right(strFileName, 1) = "m" Then
                strFileName = Left(strFileName, Len(strFileName) - 1)
            End If
           
            ' Save the file in PDF format
            oDoc.SaveAs2 FileName:=strFolder & strFileName, FileFormat:=wdFormatPDF
           
            ' Close the document and clear the object
            oDoc.Close SaveChanges:=wdDoNotSaveChanges
            Set oDoc = Nothing
           
GetNextDoc:
            ' Get the next file name
            strFileName = Dir()
        Wend
    End If
    WordBasic.DisableAutoMacros 0   'Enables auto macros
    Application.ScreenUpdating = True
End Sub



Modificat de TRaP (acum 4 luni)


pus acum 8 luni
   
TRaP
Membru activ

Inregistrat: acum 1 an
Postari: 331
Updated

The line
strFileName = Replace(strFileName, ".docx", ".pdf")

was
strFileName = Replace(LCase(strFileName), ".docx", ".pdf")

which was making the PDF files' names lowercase.

I removed LCase so they are named exactly as the Word files.


pus acum 4 luni
   
TRaP
Membru activ

Inregistrat: acum 1 an
Postari: 331
Updated

This line
.Close SaveChanges:=wdDoNotSaveChanges

was
.Close

which was prompting you to save the file.

I added SaveChanges:=wdDoNotSaveChanges so it doesn't ask you to save the doc/docx, but just closes it instead and moves to the next one.


pus acum 4 luni
   
Pagini: 1    
Mergi la