求一个读取某文件文件名代码 - VB6论坛

楼主

已结贴√ 问题点数：20 回复次数：16

求一个读取某文件文件名代码

请各位VB高手写个代码，该代码可以读取某文件夹里面指定含有关键字的文件名，是xlsx类型的，不显示后缀名按最新文件日期显示在窗口里的头条，并且用鼠标点击该文件名就可以打开该文件！谢谢！

搜索更多相关主题的帖子: 文件　读取　日期　代码　文件名　

第 2 楼

得分:0

Sub 获取分表()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim i, arr(1 To 1000, 1 To 1), f, wb As Workbook, sht As Worksheet
    For Each sht In Sheets
        If sht.Name <> "目录汇总" Then sht.Delete
    Next
    Set fso = CreateObject("scripting.filesystemobject")
    With Application.FileDialog(msoFileDialogFolderPicker)   '调用打开对话框
        If .Show = -1 Then
            Set ff = fso.getfolder(.SelectedItems(1) & "\")
            For Each fd In ff.subfolders
                f = Dir(fd.Path & "\*.xl*")
                Set wb = Workbooks.Open(fd.Path & "\" & f)   '读取
                For Each sht In wb.Worksheets
                    i = i + 1
                    sht.Copy after:=Workbooks("目录汇总.xlsm").Sheets("目录汇总")
                    ActiveSheet.Name = i
                Next
                wb.Close False
                f = Dir
            Next
        End If
    End With
    Sheets("目录汇总").Select
    MsgBox "数据导入成功！", 64, "提示！"
End Sub
Sub 超链接()
    Dim i, sht As Worksheet
    i = 1: [A2:C1000] = ""
    For Each sht In Worksheets
        If sht.Name <> "目录汇总" Then
            i = i + 1
            For j = 1 To 26
                If sht.Cells(5, j) <> "" Then Cells(i, 1) = sht.Cells(5, j): Exit For
            Next
            For j = 26 To 1 Step -1
                If sht.Cells(5, j) <> "" Then
                    Cells(i, 2) = sht.Cells(5, j)
                    If InStr(Cells(i, 2), "J") = 0 Then Cells(i, 2) = "/"
                    Exit For
                End If
            Next
            Cells(i, 3) = sht.Name
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 3), Address:=ActiveWorkbook.Name, SubAddress:="'" & sht.Name & "'!A1", TextToDisplay:=sht.Name
        End If
    Next
    MsgBox "完成！！！", 64, "提示！"
End Sub

第 3 楼

得分:5

程序代码：

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOW = 5

Dim sSelFile As String
Dim sdir As String

Private Sub Form_Load()
    sSelFile = ""
    sdir = "d:\Documents\Desktop\TTTT\"
End Sub
Private Sub Command1_Click()
    sFilter$ = "*EE*.xlsx"
    sfile$ = Dir(sdir & sFilter)
    smin$ = ""
    
    While sfile <> ""
        fileTime$ = Format(FileDateTime(sdir & sfile), "YYYYMMDDHHmmss")
        If smin < fileTime Then
            smin = fileTime
            sSelFile = sfile
        End If
        sfile = Dir()
    Wend
    inx = InStr(1, sSelFile, ".") - 1
    Label1.Caption = Mid$(sSelFile, 1, IIf(inx < 1, Len(sSelFile), inx))
End Sub


Private Sub Label1_DblClick()
    If sSelFile = "" Then Exit Sub
    ShellExecute Me.hwnd, "open", sdir & sSelFile, 0, sdir, SW_SHOW
End Sub

[此贴子已经被作者于2022-10-14 20:00编辑过]

第 4 楼

得分:15

回复 3楼 apull

子程序或函数未定义，哪里抄来的代码？

YYYYMMDDHHmmss 是个好办法，用来比较最新文件

不会遍历是个缺点

label1双击事件还有子程序或函数未定义

[此贴子已经被作者于2022-10-14 19:33编辑过]

心生万象，万象皆程序！
本人计算机知识网：http://bbs.为防伸手党，本站已停止会员注册。

第 5 楼

得分:0

遍历所有符合条件的文件，文件名（含路径）+" " + 修改时间 + " " ……切分为一维数组，分割符为空格，将2、4、6、8……位的修改时间进行排序，数组 -1 为文件名。

用这种方法可以得到最新文件 TOP 100、Top20、Top15，想TOP几都可以。

关于点击文件名就能打开文件，建议将遍历到的文件名写入html文件，可以看TOP名次，还能直接打开文件，格式如下：

<html>
<a href="file://C:\Windows">C:\Windows</a>
<a href="file://C:\Windows\notepad.exe">C:\Windows\notepad.exe</a>
</html>

IE浏览器打开html文件，查看效果。

心生万象，万象皆程序！
本人计算机知识网：http://bbs.为防伸手党，本站已停止会员注册。

第 6 楼

得分:0

回复 4楼 yuma

忘了贴api引用了。
代码是从下面抄来的。

第 7 楼

得分:0

回复 2楼约定的童话

你好！我是个小白，你这个代码贴上去我不会弄按钮，麻烦搞一个工程文件

第 8 楼

得分:0

回复 3楼 apull

你好！你这个代码我粘贴进去，读取文件夹没有显示，鼠标无法点击，麻烦搞一个详细的代码谢谢！

第 9 楼

得分:0

谢谢各位的支持！我的用途就是想用于监控内网通接收到的excel文件报表，还望各位高手支持！疫情严重请各位做好防护工作！谢谢！

第 10 楼

得分:0

回复 7楼事业男儿

我用的是Label1，你的控件名字不是Label1自然不会有双击。
看窗口图，我使用Label1显示的，双击事件也是给了Label1，你得给你的显示控件一个双击事件，把代码贴过去。否则你的label的名字也得是Label1
灵活一点，不要复制粘贴运行，这里只能是个示例，根据你的具体窗口控件写代码。