关于批量另存为的循环语句

272767951

下周一上班有一个工作，我要将一个目录文件夹下的所有CSV格式文件，全部另存到另一个文件夹下，并指定为XLSX文件。文件名称除扩展名由CSV变为XLSX外其余一律不变。
自己录制了一个宏，如下：
Sub 宏1()
    Workbooks.Open "C:\Documents and Settings\Administrator\桌面\CSV\11.csv"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Administrator\桌面\CSV\123\11.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close
End Sub

但由于涉及批量操作，循环语句我一直没写出来，求各位大神指点。
原想用for each ...next语句
思路如下：
定义一个变量为工作簿类型，
将目录文件夹下的所有CSV文件定义个集合
如果该目录在集合下，执行另存为的操作。

目前有两个问题没想明白：
一、这个集合怎么定义？
二、关于文件名的名称问题怎么处理？

自己试了近三个小时了，没试出来。求大神的代码。

清风竹-

把本文件解压后，将准备转换的一批文件，放到本文件夹内，打开“Excel格式转换工具”，点击按钮。本工具是将工作簿转换为2003格式，若转换成07或10格式的，自己改改，我用的是2003的。

272767951

太感谢了。。。。。
fullfile = cPath & Left(cFile, InStrRev(cFile, ".") - 1) & ".xls"
Filename:=fullfile
这两句没看明白。。。。

272767951

哦，原来如此。一个是定义变量值，一个是定义文件名称为该变量值。
看漏了
再次表示感谢

272767951

根据2楼提供的文件，把编码改成了如下：
Sub hj()
Dim cFile$, cPath$, Sh As Worksheet, nRow%
Dim fullfile$
On Error GoTo error

Application.ScreenUpdating = False
Application.EnableEvents = False
    cPath = ThisWorkbook.Path & "\"
    cFile = Dir(cPath & "*.csv")    ' 找寻第一个文件
  

    Do While cFile <> ThisWorkbook.Name    ' 开始循环。
      
        fullfile = cPath & Left(cFile, InStrRev(cFile, ".") - 1) & ".xlsx"
        
        
        Workbooks.Open cPath & cFile '打开文件
        ActiveWorkbook.SaveAs Filename:=fullfile, FileFormat:= _
        xlWorkbookNormal, CreateBackup:=False
           '2007.xlsm   (Fileformat:=xlOpenXMLWorkbookMacroEnabled)
        ActiveWorkbook.Close  '关闭文件
      
        cFile = Dir    ' 查找下一个文件
        
    Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
error:
Exit Sub

End Sub

不过有一个问题没有解决，就是我希望将另存为的XLSX文件存放到指定目录下，而以上代码只能存放在原目录下。
我原来的想法是：
Dim p as string
p = "指定文件夹目录"
..
ActiveWorkbook.SaveAs Filename:=P & fullfile

但不知道这个为什么不对，是压根不能这么写，还是我的格式有错误？
求大神解释

hehex

272767951 发表于 2013-2-3 13:19
根据2楼提供的文件，把编码改成了如下：
Sub hj()
Dim cFile$, cPath$, Sh As Worksheet, nRow%

p = "指定文件夹目录"

比如指定文件夹是 C:\11
你是设的 p= "C:\11" 这样对不对？
那么就应该是 p & "\" & fullfile
如果还不对，很简单
在 ActiveWorkbook.SaveAs Filename:=P & fullfile 语句前面修改为
debug.print  P & fullfile
stop
ActiveWorkbook.SaveAs Filename:=P & fullfile

重新执行程序，程序到stop 那里就会停止，这是断点语句。
你会在立即窗口看到你的  P & fullfile  的全部内容，路径哪里不对，一目了然。
改好后将debug.print 和stop 这样的调试语句去掉就好了。

272767951

hehex 发表于 2013-2-3 16:47
p = "指定文件夹目录"

比如指定文件夹是 C:\11

其实以我的习惯，我一般都在路径后面加上那个"\"
所以我是写成
P="C:\11\"的。
按照你说的，我重新增加了代码看了下。在立即窗口显示如下：
C:\Documents and Settings\Administrator\桌面\Excel格式转换工具\555\C:\Documents and Settings\Administrator\桌面\Excel格式转换工具\1.xlsx
现在看来问题就出在这里：
fullfile = cPath & Left(cFile, InStrRev(cFile, ".") - 1) & ".xlsx"
原语句是：
ActiveWorkbook.SaveAs Filename:=fullfile
在原语句中，fullfile是包含其路径的，
而新语句写成：ActiveWorkbook.SaveAs Filename:=P & fullfile ，那么，就会造成路径错误。
依此看来，下一步需要对fullfile这个变量的赋值进行更改，
原代码：fullfile = cPath & Left(cFile, InStrRev(cFile, ".") - 1) & ".xlsx"
这句应该是提取字符串的，提取“。”之前的字符。
现在要改成提取最后一个“\”和“。”中间的字符。
容我想一想怎么写

272767951

Option Explicit

Sub hj()
Dim cFile$, cPath$, Sh As Worksheet, nRow%
Dim fullfile$
Dim p As String

Application.ScreenUpdating = False
Application.EnableEvents = False
    cPath = ThisWorkbook.Path & "\"
    cFile = Dir(cPath & "*.csv")    ' 找寻第一个文件
    p = "C:\Documents and Settings\Administrator\桌面\Excel格式转换工具\555\"

    Do While cFile <> ThisWorkbook.Name    ' 开始循环。
      
        fullfile = p & Left(cFile, InStrRev(cFile, ".") - 1) & ".xlsx"
        
        
        Workbooks.Open cPath & cFile '打开文件
        ActiveWorkbook.SaveAs Filename:=fullfile, FileFormat:= _
        xlWorkbookNormal, CreateBackup:=False
           '2007.xlsm   (Fileformat:=xlOpenXMLWorkbookMacroEnabled)
        ActiveWorkbook.Close  '关闭文件
      
        cFile = Dir    ' 查找下一个文件
        
    Loop

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub


重新写成了这种形式，这样确实把原文件另存到指定文件夹下，但为什么生成的文件打不开，显示格式扩展名无效？

272767951

Sub hj()
Dim cFile$, cPath$, Sh As Worksheet, nRow%
Dim fullfile$
On Error GoTo error

Application.ScreenUpdating = False
Application.EnableEvents = False
    cPath = ThisWorkbook.Path & "\"
    cFile = Dir(cPath & "*.csv")    ' 找寻第一个文件
  

    Do While cFile <> ThisWorkbook.Name    ' 开始循环。
      
        fullfile = "C:\Documents and Settings\Administrator\桌面\Excel格式转换工具\555\" & Left(cFile, InStrRev(cFile, ".") - 1) & ".xlsx"
        
        
        Workbooks.Open cPath & cFile '打开文件
        ActiveWorkbook.SaveAs Filename:=fullfile, FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
           '2007.xlsm   (Fileformat:=xlOpenXMLWorkbookMacroEnabled)
        ActiveWorkbook.Close  '关闭文件
      
        cFile = Dir    ' 查找下一个文件
        
    Loop

Application.EnableEvents = True
Application.ScreenUpdating = True
error:
Exit Sub

End Sub

272767951

发现自己笨死了，就一个路径设个变量没多大意义，直接写上算了。
造成之前文件扩展名无效的原因是：
FileFormat:= xlWorkbookNormal
我用的是2010，那么应该写成
fileformate:=xlOpenXMLWorkbook
至此，问题全部解决。
再次感谢“清风竹-”和“hehex ”两位大神。