Foxtable(狐表)用户栏目专家坐堂 → 查看和打开文件夹下所有某类文件


  共有1758人关注过本帖树形打印复制链接

主题:查看和打开文件夹下所有某类文件

帅哥哟,离线,有人找我吗?
hpbcfmqr
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:117 积分:1207 威望:0 精华:0 注册:2017/10/8 12:29:00
查看和打开文件夹下所有某类文件  发帖心情 Post By: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

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/10/10 14:05:00 [只看该作者]


 回到顶部