单层级 doc-docx

Sub ConvertBatchToDOCX()
    Dim sSourcePath As String
    Dim sTargetPath As String
    Dim sDocName As String
    Dim docCurDoc As Document
    Dim sNewDocName As String

    ' Looking in this path
    sSourcePath = "F:\wz\003-报告\后评价\2016问题建议后评价2-xls2\"
  

   ' Look for first DOC file
    sDocName = Dir(sSourcePath & "*.doc")
    Do While sDocName <> ""
    
     
        ' Repeat as long as there are source files
        
        'Only work on files where right-most characters are ".doc"
        If Right(sDocName, 4) = ".doc" Then
        
          
            
            ' Open file
              Set docCurDoc = Documents.Open(FileName:=sSourcePath & sDocName)


            sNewDocName = Replace(sDocName, ".doc", ".docx")

            With docCurDoc
                .SaveAs FileName:=sTargetPath & sNewDocName, _
                  FileFormat:=wdFormatDocumentDefault
                .Close SaveChanges:=wdDoNotSaveChanges
                
                
            End With
            
         
        End If
        ' Get next source file name
        sDocName = Dir
        
        
        
    Loop
    MsgBox "Finished"
End Sub

使用office宏命令 2级目录转换doc- docx

Sub ConvertBatchToDOCX()
    Dim sSourcePath As String
   
    Dim sDocName As String
    Dim sDocNameOut As String
    Dim docCurDoc As Document
    Dim sNewDocName As String

    ' Looking in this path
    sSourcePath = "F:\wz\003-报告\后评价\2015问题建议后评价1-xls2\"
  
    Dim p2 As String

   ' Look for first DOC file
   
    Set fso = CreateObject("scripting.filesystemobject") '创建FSO对象
    Set folder = fso.getfolder(sSourcePath)
   
   
    For Each sfd In folder.SubFolders
        ' MsgBox (sfd)
       ' FindFile sfd, FileName  ' 循环查找
       
         p2 = sfd.Path + "\"
         
         sDocName = Dir(p2 & "*.doc")
         Do While sDocName <> ""
        
         
            
        ' Repeat as long as there are source files
        
        'Only work on files where right-most characters are ".doc"
            If Right(sDocName, 4) = ".doc" And Left(sDocName, 5) = "4-最终版" Then
        
          
            
            ' Open file
                Set docCurDoc = Documents.Open(FileName:=p2 & sDocName)


                sNewDocName = Replace(sDocName, ".doc", ".docx")

                With docCurDoc
                    .SaveAs FileName:=p2 & sNewDocName, _
                    FileFormat:=wdFormatDocumentDefault
                    .Close SaveChanges:=wdDoNotSaveChanges
                
                
                End With
            
         
             End If
        ' Get next source file name
            
             sDocName = Dir
             
        Loop
    Next
    
   
  
    MsgBox "Finished"
End Sub