批量将Excel2003格式文件保存为2007格式的程序[5.23日更新]

泓()

先看看是什么东东，分享可敬！

kepeng100

谢谢分享,不错!

能否再加以改进一点,
1.如果是07版格式的,就不要再又复制一个文件,那样就重复了,只改03版的

2.路径能否改进为一个盘里面,因为你的程序只适合在一个文件夹里,那样有局限性,我们电脑里的文件一般都分了好多个文件夹,如果一个一个的来转换,有点麻烦

LAOMALIN

楼上的要求真多，别让杀毒软件当病毒kill了

三戒

原帖由 kepeng100 于 2009-7-18 11:40 发表
谢谢分享,不错!

能否再加以改进一点,
1.如果是07版格式的,就不要再又复制一个文件,那样就重复了,只改03版的

2.路径能否改进为一个盘里面,因为你的程序只适合在一个文件夹里,那样有局限性,我们电脑里的文件一般 ...

请测试
保存为2007.rar (33.87 KB, 下载次数: 243)

2009-7-22 10:06 上传

点击文件名下载附件

zzf_

学习一下，尽管还在用03office

ddwtibet

好  正需要

ty1013

有没有将07的转为03的呢

JLF2003

很不错了!向老师学习!

泓()

先看看是什么东东，分享可敬！

zhangyong

感谢三戒高手提供的好东西，我在国外的好多Excel论坛上都有人抱怨这个问题，我试了很多他们提供的代码，这个是比较经典的一个。转过来大家一起享受！

Excel
VBA
Application.FileSearch
2003
2007

'!!!! Replacement solution including searching in subdirectories !!!


//------------------------------------------------------------------------------------------------

Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection    ' create a collection of filenames

' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls", True)

' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh    ' cycle for list(collection) processing
        Debug.Print FileNameWithPath & Chr(13)
        MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath

' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
    Debug.Print "No file was found !"
    MsgBox "No file was found !"
End If

End Sub

//------------------------------------------------------------------------------------------------

Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile  'add file name to list(collection)
DirFile = Dir ' next file
Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub

' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
    ' Add subdirectory to local list(collection) of subdirectories in path
    If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
    DirFile = Dir 'next file
Loop

' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
     Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call
Next

End Sub

//------------------------------------------------------------------------------------------------