专家好,我想查看并打开某文件夹下所有excel文件,这个文件夹有可能还有子文件夹,怎么用狐表编程呀,以前在vb用编程就用一个函数就行
例如这是我在vba中编的程序,在狐表中怎样编这样的程序呢:
Sub sosuofile(MyPath As String)
Dim Myname As String
Dim dir_i() As String
Dim i, idir As Long
If Right(MyPath, 1) <> "\" Then MyPath = MyPath + "\"
Myname = Dir(MyPath, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
Do While Myname <> ""
If Myname <> "." And Myname <> ".." Then
If (GetAttr(MyPath & Myname) And vbDirectory) = vbDirectory Then '如果找到的是目录
idir = idir + 1
ReDim Preserve dir_i(idir) As String
dir_i(idir - 1) = Myname
Else:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If InStr(MyPath & Myname, "备用") <> 0 Then GoTo 151617
If InStr(Myname, ".xls") = 0 Then GoTo 151617
If InStr(Myname, "文件夹名称排序批量修改") <> 0 Then GoTo 151617
If InStr(Myname, "修改文件排序程序") <> 0 Then GoTo 151617
If InStr(Myname, "$") <> 0 Then GoTo 151617
If InStr(Myname, "归档目录") <> 0 Then GoTo 151617
If InStr(Myname, "查找结果") <> 0 Then GoTo 151617
If InStr(Myname, "fmmlbkb") <> 0 Or InStr(Myname, "封面目录") <> 0 Then
Excel.Application.Workbooks.Open MyPath & Myname
ThisWorkbook.Sheets("归档目录").Cells(rtr, 1).Value = rtr - 3
ThisWorkbook.Sheets("归档目录").Cells(rtr, 1).Font.Bold = False
If Excel.Workbooks(Myname).Sheets("封面").Cells(9, 1) = "" Then ttmm1 = Excel.Workbooks(Myname).Sheets("封面").Cells(9, 2)
If Excel.Workbooks(Myname).Sheets("封面").Cells(9, 2) = "" Then ttmm1 = Excel.Workbooks(Myname).Sheets("封面").Cells(9, 1)
If Excel.Workbooks(Myname).Sheets("封面").Cells(10, 1) = "" Then ttmm2 = Excel.Workbooks(Myname).Sheets("封面").Cells(10, 2)
If Excel.Workbooks(Myname).Sheets("封面").Cells(10, 2) = "" Then ttmm2 = Excel.Workbooks(Myname).Sheets("封面").Cells(10, 1)
ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).Value = ttmm1 & ttmm2
ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).Font.Bold = False
ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).HorizontalAlignment = xlLeft
ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).VerticalAlignment = xlCenter
ThisWorkbook.Sheets("归档目录").Cells(rtr, 3).Value = Excel.Workbooks(Myname).Sheets("封面").Cells(18, 10)
ThisWorkbook.Sheets("归档目录").Cells(rtr, 3).Font.Bold = False
ysys = ThisWorkbook.Sheets("归档目录").Cells(rtr, 3).Value
If ysys <= 150 Then ThisWorkbook.Sheets("归档目录").Cells(rtr, 10).Value = 2
If ysys > 150 And ysys <= 250 Then ThisWorkbook.Sheets("归档目录").Cells(rtr, 10).Value = 3
If ysys > 250 And ysys <= 350 Then ThisWorkbook.Sheets("归档目录").Cells(rtr, 10).Value = 4
If ysys > 350 And ysys <= 450 Then ThisWorkbook.Sheets("归档目录").Cells(rtr, 10).Value = 5
If ysys > 450 Then ThisWorkbook.Sheets("归档目录").Cells(rtr, 10).Value = 6
ThisWorkbook.Sheets("归档目录").Cells(rtr, 4).Value = Excel.Workbooks(Myname).Sheets("封面").Cells(17, 3)
ThisWorkbook.Sheets("归档目录").Cells(rtr, 4).Font.Bold = False
ThisWorkbook.Sheets("归档目录").Cells(rtr, 5).Value = Excel.Workbooks(Myname).Sheets("封面").Cells(18, 3)
ThisWorkbook.Sheets("归档目录").Cells(rtr, 5).Font.Bold = False
'Excel.Workbooks(Myname).Save
Excel.Workbooks(Myname).Close (False)
ThisWorkbook.Sheets("归档目录").Cells(rtr, 90).Value = MyPath & Myname
ThisWorkbook.Sheets("归档目录").Cells(rtr, 9).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MyPath & Myname, _
TextToDisplay:=" "
hfg = "J" & rtr
' ThisWorkbook.Sheets("归档目录").Range("I4:I60000").ClearComments
' ThisWorkbook.Sheets("归档目录").Range(hfg).AddComment
' ThisWorkbook.Sheets("归档目录").Range(hfg).Comment.Visible = False
' ThisWorkbook.Sheets("归档目录").Range(hfg).Comment.Text Text:=Mid(MyPath & Myname, Len(ThisWorkbook.Path) + 1, 150)
ThisWorkbook.Sheets("归档目录").Cells(rtr, 9).HorizontalAlignment = xlCenter
ThisWorkbook.Sheets("归档目录").Cells(rtr, 9).VerticalAlignment = xlCenter
ThisWorkbook.Sheets("归档目录").Cells(rtr, 9).ReadingOrder = xlContext
If ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).Value <> "" Then
ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).Rows.AutoFit
End If ' If ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).Value <> "" Then
If ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).RowHeight < 42.75 Or ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).Value = "" Then
ThisWorkbook.Sheets("归档目录").Cells(rtr, 2).RowHeight = 42.75
End If ' If ThisWorkbook.Sheets("归档目录")
rtr = rtr + 1
End If 'If InStr(Myname, "fmmlbkb") <> 0 Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
151617:
End If
End If
Myname = Dir '搜索下一项
Loop
For i = 0 To idir - 1
Call sosuofile(MyPath + dir_i(i))
Next i
ReDim dir_i(0) As String
End Sub