批量将doc与docx文件互相转换

dogingate

代码如下：

1. Sub doc2docx()    'doc文件转docx文件
   
2.    
   
3.     Dim myDialog As FileDialog
   
4.     Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
   
5.     Dim oFile As Object
   
6.     Dim oFilePath As Variant
   
7.    
   
8.     With myDialog
   
9.         .Filters.Clear    '清除所有文件筛选器中的项目
   
10.         .Filters.Add "所有 WORD2007 文件", "*.doc", 1    '增加筛选器的项目为所有doc文件
    
11.         .AllowMultiSelect = True    '允许多项选择
    
12.         If .Show = -1 Then    '确定
    
13.             For Each oFilePath In .SelectedItems    '在所有选取项目中循环
    
14.                 Set oFile = Documents.Open(oFilePath)
    
15.                 oFile.SaveAs FileName:=Replace(oFilePath, "doc", "docx"), FileFormat:=16
    
16.                 oFile.Close
    
17.             Next
    
18.     End If
    
19.    
    
20. End With
    
21. 
    
22. End Sub

复制代码

dogingate

1. Sub docx2doc()    'docx文件转doc文件
   
2.    
   
3.     Dim myDialog As FileDialog
   
4.     Set myDialog = Application.FileDialog(msoFileDialogFilePicker)
   
5.     Dim oFile As Object
   
6.     Dim oFilePath As Variant
   
7.    
   
8.     With myDialog
   
9.         .Filters.Clear    '清除所有文件筛选器中的项目
   
10.         .Filters.Add "所有 WORD2007 文件", "*.docx", 1    '增加筛选器的项目为所有doc文件
    
11.         .AllowMultiSelect = True    '允许多项选择
    
12.         If .Show = -1 Then    '确定
    
13.             For Each oFilePath In .SelectedItems    '在所有选取项目中循环
    
14.                 Set oFile = Documents.Open(oFilePath)
    
15.                 oFile.SaveAs FileName:=Replace(oFilePath, "docx", "doc"), FileFormat:=0
    
16.                 oFile.Close
    
17.             Next
    
18.     End If
    
19.    
    
20. End With
    
21. 
    
22. End Sub

复制代码

lizhipei78

非常感谢，非常实用的功能

dogingate

lizhipei78 发表于 2020-9-27 12:49
非常感谢，非常实用的功能

1. Function GetRandNumber(ByVal lMin As Long, ByVal lMax As Long)
   
2.     '生成一个随机数seed
   
3.     Randomize
   
4.     Dim arr()
   
5.     Dim arrResult()
   
6.     ReDim arr(lMin To lMax)
   
7.     '先生成准备要取随机数的数组序列
   
8.     For i = lMin To lMax
   
9.         arr(i) = i
   
10.     Next i
    
11.     ReDim arrResult(lMin To lMax)
    
12.     lEnd = lMax
    
13.     For i = lMin To lMax
    
14.         '每次生成lMin到lEnd之间的随机整数
    
15.         j = Int(VBA.Rnd() * (lEnd - lMin + 1) + lMin)
    
16.         '把j位置的值取出放到随机数结果数组中
    
17.         arrResult(i) = arr(j)
    
18.         '将j位置的值与lEnd位置的值交换，保证下次不会再取到这个值
    
19.         arr(j) = arr(lEnd)
    
20.         '每次交换结束后，将lEnd减去1，保证不会再取到刚才取到的值。
    
21.         lEnd = lEnd - 1
    
22.     Next i
    
23.     GetRandNumber = arrResult
    
24. End Function

复制代码

goldowl2011

谢谢，不错，标识下载。

blackttea1

非常实用的功能

ww0000

dogingate 发表于 2020-9-8 09:16

老师，出现要求对象的错误提示

ww0000

请问，提示要求对象怎么回事？

592rmb

这个好，留下选用，非常感谢