以文本方式查看主题 - Foxtable(狐表) (http://foxtable.net/bbs/index.asp) -- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2) ---- 查看和打开文件夹下所有某类文件 (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=107799) |
-- 作者:hpbcfmqr -- 发布时间:2017/10/10 13:43:00 -- 查看和打开文件夹下所有某类文件 专家好,我想查看并打开某文件夹下所有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
|
-- 作者:有点甜 -- 发布时间:2017/10/10 14:05:00 -- 参考
http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=107338&skin=0
|