b=dir无效的调用或参数，请教一下？

yellow777

以下代码是把把"d:\aa"目录中所有excel文件打开，进行格式化，另存到其它的目录中，本来很好，由于需要把另存的目录建一个第个字段中文件夹存入其中，加了紫色部分的代码，加了以后处理也没问题，就是不能进行循环了，提示“b=dri无效的调用或参数”，为什么会出现这种情况呢，是在建立文件夹操作之后，b的变量进行变化了？

sub dy()
Dim b
  'Application.ScreenUpdating = False
  'Application.DisplayAlerts = False
   If Dir("d:\ftp\", vbDirectory) = "" Then
    MkDir "d:\ftp\"
    End If
    If Dir("d:\ftp\查询\", vbDirectory) = "" Then
    MkDir "d:\ftp\查询\"
    End If
    If Dir("D:\ftp\查询\查询结果\", vbDirectory) = "" Then
    MkDir "D:\ftp\查询\查询结果\"
    End If

  b = Dir("d:\aa\*.xls")
  Do While b <> ""
    Workbooks.Open Filename:="d:\aa\" & b
MsgBox b
aa = ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Value
    bb = Mid(aa, 7, (Len(aa) - 7))
   
    mm = "D:\ftp\查询\查询结果\" & bb & "\"
    If Dir(mm, vbDirectory) = "" Then
    MkDir mm
    End If
    Workbooks(b).Activate
    Call whc
    Workbooks(b).Activate
   
   
    abc = mm & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "-" & Trim(bb) & ".xls"
   
Workbooks(b).Activate
   
   
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=abc
      ActiveWorkbook.Close False
     Kill "d:\aa\" & b
   
    b = Dir
  Loop
  MsgBox "d:\aa文件里没有文件！"
  MsgBox "全部处理完毕!"
End Sub

yellow777

把b=dir,换成b = Dir("d:\aa\*.xls")，解决，请高手给分析一下是什么原因呢，

jygzcj

mm = "D:\ftp\查询\查询结果\" & bb & "\"
    If Dir(mm, vbDirectory) = "" Then
    MkDir mm
    End If
这个去掉如何？

joforn

调用Dir时要注意：
Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名，再一次调用 Dir，且不要使用参数。如果已没有合乎条件的文件，则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串，并要再次调用 Dir 时，就必须指定 pathname，否则会产生错误。不必访问到所有匹配当前 pathname 的文件名，就可以改变到一个新的 pathname 上。但是，不能以递归方式来调用 Dir 函数。以 vbDirectory 属性来调用 Dir 不能连续地返回子目录。

1. 
   
2. Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long
   
3. 
   
4. Private Const MAX_PATH    As Long = 260
   
5. 
   
6. '创建目录
   
7. Public Function MKDirctory(ByVal Path As String) As Boolean
   
8.   '如果目录创建成功，或目录已经存在，都将返回True
   
9.   '此函数可建立多重目录。
   
10.   Path = Path & String(MAX_PATH, vbNullChar)
    
11.   PathAddBackslashW StrPtr(Path)
    
12.   MKDirctory = MakeSureDirectoryPathExists(Path)
    
13. End Function
    
14. 
    
15. Sub dy()
    
16.   Dim B As String
    
17.   'Application.ScreenUpdating = False
    
18.   'Application.DisplayAlerts = False
    
19.   MKDirctory "D:\ftp\查询\查询结果"
    
20.   B = Dir("d:\aa\*.xls")
    
21.   Do While B <> ""
    
22.     Workbooks.Open Filename:="d:\aa" & B
    
23.     MsgBox B
    
24.     aa = ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, 1).Value
    
25.     bb = Mid(aa, 7, (Len(aa) - 7))
    
26.    
    
27.     mm = "D:\ftp\查询\查询结果" & bb & ""
    
28.     MKDirctory mm
    
29.     Workbooks(B).Activate
    
30.     Call whc
    
31.     Workbooks(B).Activate
    
32.    
    
33.    
    
34.     abc = mm & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & "-" & Trim(bb) & ".xls"
    
35.    
    
36.     Workbooks(B).Activate
    
37.    
    
38.    
    
39.     ActiveWorkbook.Save
    
40.     ActiveWorkbook.SaveAs Filename:=abc
    
41.     ActiveWorkbook.Close False
    
42.     Kill "d:\aa" & B
    
43.    
    
44.     B = Dir
    
45.   Loop
    
46.   MsgBox "d:\aa文件里没有文件！"
    
47.   MsgBox "全部处理完毕!"
    
48. End Sub
    

复制代码