精华内容
下载资源
问答
  • 如果需要对用户指定的文件进行操作,可以使用GetOpenFilename方法打开Excel内置的【打开】对话框,获取用户选择的文件名,此过程并不需要真正打开文件,示例代码如下。 Sub SelectFile() Dim vntFilename As ...

    如果需要对用户指定的文件进行操作,可以使用GetOpenFilename方法打开Excel内置的【打开】对话框,获取用户选择的文件名,此过程并不需要真正打开文件,示例代码如下。

    Sub SelectFile()
         Dim vntFilename As Variant
         Dim i As Integer
         vntFilename = Application.GetOpenFilename(Title:="浏览文件", _
             FileFilter:="所有文件 (*.*),*.*,Excel文件 (*.xls*),*.xls*", _
             FilterIndex:=2, MultiSelect:=True)
         If IsArray(vntFilename) = True Then'判断是否为数组
             With Sheet1
                 .Cells.ClearContents
                 .Cells(1, 1) = "文件名"
                 For i = 1 To UBound(vntFilename)
                     .Cells(i + 1, 1) = vntFilename(i)
                 Next i
             End With
         End If
     End Sub

    第4行代码使用Application对象的GetOpenFilename方法打开Excel内置的【打开】对话框,供用户选择文件并将选择的文件名赋值给vntFilename,其语法格式如下。

    GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)

    各参数说明如下。

    名称必选/可选数据类型说明
    FileFilter可选Variant一个指定文件筛选条件的字符串。由文件筛选字符串和通配符文件筛选规范组成,多个筛选条件之间用逗号隔开。如果省略则默认值为"所有文件(*.*)"。并且是成对存在,前一个是筛选类型描述,后一个是筛选规则
    FilterIndex可选Variant指定默认文件筛选条件的索引号,取值范围为 1 到由 FileFilter  所指定的筛选条件数目。如果省略该参数,或者该参数的值大于可用筛选条件数,则使用第一个文件筛选条件。即对话框右下角的文件筛选类型。
    Title可选Variant指定对话框的标题。如果省略该参数,则标题为“打开”。
    ButtonText可选Variant仅用于Macintosh。
    MultiSelect可选Variant如果为 True,则允许选择多个文件名。如果为  False,则只允许选择一个文件名。默认值为 False

    GetOpenFilename方法的返回值是一个包含所有选定文件名及文件路径的数组。

    如果用户单击对话框中的【取消】按钮或【关闭】按钮,则返回值为False。

    第11行代码中的UBound函数返回指定数组维的上界。

     


    微信公众号:VBA168

    淘宝店铺地址:https://item.taobao.com/item.htm?spm=a1z10.1-c-s.w4004-21233576391.4.1af0683dzrx3oU&id=584940166162

    关注微信公众号,每天及时接收Excel VBA经典示例讲解。

    淘宝店铺提供Excel定制服务。

    祝你工作和学习更轻松!

    展开全文
  • vba文件名提取

    2020-11-27 10:40:28
    Sub shishi() Dim ad As String ad = GetFileName("a\20201602.xlss") ... '获取文件名的自定义函数 Dim sTemp As String sTemp = sName '判断后缀名分隔符.的位置 iPos = Len(sTemp) - VBA.InStr(1, VBA....

    Sub shishi()
       Dim ad As String
     ad = GetFileName("a\20201602.xlss")
    MsgBox (ad)

    End Sub


    Function GetFileName(ByVal sName As String)
        '获取纯文件名的自定义函数
        Dim sTemp As String
        sTemp = sName
        '判断后缀名分隔符.的位置
        iPos = Len(sTemp) - VBA.InStr(1, VBA.StrReverse(sTemp), ".")
        If iPos <> 0 Then
            sTemp = Mid(sTemp, 1, iPos)
        End If
       ' MsgBox (sTemp)
        '判断路径分隔符\的位置
        iPos = VBA.InStr(1, sTemp, "\")
        If iPos <> 0 Then
            '反转后好取字符
            iPos = VBA.InStr(1, VBA.StrReverse(sTemp), "\")
            MsgBox (sTemp)
            sTemp = Mid(VBA.StrReverse(sTemp), 1, iPos - 1)
            sTemp = VBA.StrReverse(sTemp)
        End If
        GetFileName = sTemp
    End Function

    展开全文
  • 2.获取文件夹内所有文件; 3.在Excel里面将文件改后名写好; 4.更改文件名; 5.清空数据; 二、代码实现 1.可视化选择文件夹代码 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 ...

    一、设计思路

    1.选择要修改文件的文件夹;

    2.获取文件夹内所有文件;

    3.在Excel里面将文件改后名写好;

    4.更改文件名;

    5.清空数据;

     二、代码实现

    1.可视化选择文件夹代码

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            qh_select_path = .SelectedItems(1)
            qh_path_oo = .SelectedItems(1)
        End If
    End With

    2.获取文件夹内所有文件列表函数

    Function qh_get_all_file_fun(Optional qh_mypath0)    '获取文件夹内所有文件列表   作者:阙辉   20210429
    Dim qh_myfso As Object
    Dim qh_mypath
    Dim qh_myfile
    Dim qh_FolderName
    Dim qh_myfile_count As Long
    Dim qh_myfile_array
    Dim qh_i As Long
    
    On Error Resume Next
    
    qh_mypath = qh_mypath0      '路径 阙
    
    '路径为空则取文件同一文件夹 阙
    If qh_mypath = "" Then
        qh_mypath = ThisWorkbook.Path '& "\" & qh_FolderName
    Else
        qh_mypath = qh_mypath
    End If
    
    '实例化对象 阙
    Set qh_myfso = CreateObject("Scripting.FileSystemObject")
    '获取文件  阙
    Set qh_myfile = qh_myfso.GetFolder(qh_mypath).Files
    '获取文件数量
    qh_myfile_count = qh_myfso.GetFolder(qh_mypath).Files.Count
    
    '重定义数组 阙
    ReDim qh_myfile_array(1 To qh_myfile_count)
    '将文件名存储数组  阙
    qh_i = 1
    For Each qh_sh In qh_myfile
        qh_myfile_array(qh_i) = qh_sh.Name
        qh_i = qh_i + 1
    '    MsgBox qh_myfso.GetExtensionName(qh_mypath & "\" & qh_sh.Name)   获取文件拓展名
    Next
    
    qh_get_all_file_fun = Array(qh_myfile_array, qh_myfile_count)
    '输出数组:0 文件列表,1文件数量
    
    End Function

    3.获取文件列表主程序代码

    Sub qh_get_all_file_sub(quehui)
    If quehui <> "QH" Then
        Exit Sub
    End If
    
    On Error Resume Next
    Dim qh_xu
    Dim qh_file_count As Long
    'aa = Application.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            qh_select_path = .SelectedItems(1)
            qh_path_oo = .SelectedItems(1)
        End If
    End With
    
    qh_file_array = qh_get_all_file_fun(qh_select_path)
    qh_file_count = qh_file_array(1)
    qh_file_array0 = qh_file_array(0)
    qh_file_count_00 = qh_file_count
    
    ReDim qh_xu(1 To qh_file_count)
    
    For qh_i = 1 To qh_file_count
        qh_xu(qh_i) = qh_i
    Next
    
    With Sheets(1)
        .Range("A5").Resize(qh_file_count) = Application.Transpose(qh_xu)
        .Range("B5").Resize(qh_file_count) = Application.Transpose(qh_file_array0)
    End With
    
    End Sub

    4.修改文件名主程序代码

    Sub qh_update_file_name(quehui)
    If quehui <> "QH" Then
        Exit Sub
    End If
    
    If qh_path_oo = "" Or qh_file_count_00 = "" Then
        MsgBox "请重新运行'获取文件',QH!"
        Exit Sub
    End If
    
    qh_count = qh_file_count_00 + 5 - 1
    
    '实例化对象 阙
    Set qh_myfso = CreateObject("Scripting.FileSystemObject")
    
    With Sheets("QH_文件修改")
    For qh_i = 5 To qh_count
        qh_old_name = qh_path_oo & "\" & .Cells(qh_i, 2)
        qh_HouZhuiMing = qh_myfso.GetExtensionName(qh_old_name)
        qh_new_name0 = .Cells(qh_i, 3)
        qh_new_name = qh_path_oo & "\" & qh_new_name0 & "." & qh_HouZhuiMing
        On Error Resume Next
    '    On Error GoTo QH_ERROR1
        
        '如果改名称为空则不执行修改  日志报修改失败
        If qh_new_name0 <> "" Then
            Name qh_old_name As qh_new_name
            qh_KongBai = False
        Else
            '空白 qh_KongBai则为真
            qh_KongBai = True
        End If
        If qh_myfso.FileExists(qh_new_name) Then
            .Cells(qh_i, 4) = "修改成功,QH!"
            .Cells(qh_i, 5) = .Cells(qh_i, 3) & "." & qh_HouZhuiMing
        ElseIf qh_KongBai Then
            .Cells(qh_i, 4) = "改文件名(新)不能为空,QH!"
            .Cells(qh_i, 5) = ""
        Else
            .Cells(qh_i, 4) = "修改失败,QH!"
            .Cells(qh_i, 5) = ""
        End If
    Next
    'Exit Sub
    'QH_ERROR1:
    '
    'Resume Next
    End With
    End Sub

    5.清空数据调用程序代码

    Sub qh_clear_data(quehui)
    If quehui <> "QH" Then
        Exit Sub
    End If
    With Sheets("QH_文件修改")
        .Range("A5:E100000").ClearContents
    End With
    End Sub

    6.完整代码

    Public qh_path_oo   '定义公共变量
    Public qh_file_count_00   '定义公共变量
    Function qh_get_all_file_fun(Optional qh_mypath0)    '获取文件夹内所有文件列表   作者:阙辉   20210429
    Dim qh_myfso As Object
    Dim qh_mypath
    Dim qh_myfile
    Dim qh_FolderName
    Dim qh_myfile_count As Long
    Dim qh_myfile_array
    Dim qh_i As Long
    
    On Error Resume Next
    
    qh_mypath = qh_mypath0      '路径 阙
    
    '路径为空则取文件同一文件夹 阙
    If qh_mypath = "" Then
        qh_mypath = ThisWorkbook.Path '& "\" & qh_FolderName
    Else
        qh_mypath = qh_mypath
    End If
    
    '实例化对象 阙
    Set qh_myfso = CreateObject("Scripting.FileSystemObject")
    '获取文件  阙
    Set qh_myfile = qh_myfso.GetFolder(qh_mypath).Files
    '获取文件数量
    qh_myfile_count = qh_myfso.GetFolder(qh_mypath).Files.Count
    
    '重定义数组 阙
    ReDim qh_myfile_array(1 To qh_myfile_count)
    '将文件名存储数组  阙
    qh_i = 1
    For Each qh_sh In qh_myfile
        qh_myfile_array(qh_i) = qh_sh.Name
        qh_i = qh_i + 1
    '    MsgBox qh_myfso.GetExtensionName(qh_mypath & "\" & qh_sh.Name)   获取文件拓展名
    Next
    
    qh_get_all_file_fun = Array(qh_myfile_array, qh_myfile_count)
    '输出数组:0 文件列表,1文件数量
    
    End Function
    Sub qh_get_all_file_sub(quehui)
    If quehui <> "QH" Then
        Exit Sub
    End If
    
    On Error Resume Next
    Dim qh_xu
    Dim qh_file_count As Long
    'aa = Application.GetOpenFilename(FileFilter, FilterIndex, Title, ButtonText, MultiSelect)
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            qh_select_path = .SelectedItems(1)
            qh_path_oo = .SelectedItems(1)
        End If
    End With
    
    qh_file_array = qh_get_all_file_fun(qh_select_path)
    qh_file_count = qh_file_array(1)
    qh_file_array0 = qh_file_array(0)
    qh_file_count_00 = qh_file_count
    
    ReDim qh_xu(1 To qh_file_count)
    
    For qh_i = 1 To qh_file_count
        qh_xu(qh_i) = qh_i
    Next
    
    With Sheets(1)
        .Range("A5").Resize(qh_file_count) = Application.Transpose(qh_xu)
        .Range("B5").Resize(qh_file_count) = Application.Transpose(qh_file_array0)
    End With
    
    End Sub
    Sub qh_update_file_name(quehui)
    If quehui <> "QH" Then
        Exit Sub
    End If
    
    If qh_path_oo = "" Or qh_file_count_00 = "" Then
        MsgBox "请重新运行'获取文件',QH!"
        Exit Sub
    End If
    
    qh_count = qh_file_count_00 + 5 - 1
    
    '实例化对象 阙
    Set qh_myfso = CreateObject("Scripting.FileSystemObject")
    
    With Sheets("QH_文件修改")
    For qh_i = 5 To qh_count
        qh_old_name = qh_path_oo & "\" & .Cells(qh_i, 2)
        qh_HouZhuiMing = qh_myfso.GetExtensionName(qh_old_name)
        qh_new_name0 = .Cells(qh_i, 3)
        qh_new_name = qh_path_oo & "\" & qh_new_name0 & "." & qh_HouZhuiMing
        On Error Resume Next
    '    On Error GoTo QH_ERROR1
        
        '如果改名称为空则不执行修改  日志报修改失败
        If qh_new_name0 <> "" Then
            Name qh_old_name As qh_new_name
            qh_KongBai = False
        Else
            '空白 qh_KongBai则为真
            qh_KongBai = True
        End If
        If qh_myfso.FileExists(qh_new_name) Then
            .Cells(qh_i, 4) = "修改成功,QH!"
            .Cells(qh_i, 5) = .Cells(qh_i, 3) & "." & qh_HouZhuiMing
        ElseIf qh_KongBai Then
            .Cells(qh_i, 4) = "改文件名(新)不能为空,QH!"
            .Cells(qh_i, 5) = ""
        Else
            .Cells(qh_i, 4) = "修改失败,QH!"
            .Cells(qh_i, 5) = ""
        End If
    Next
    'Exit Sub
    'QH_ERROR1:
    '
    'Resume Next
    End With
    End Sub
    Sub qh_clear_data(quehui)
    If quehui <> "QH" Then
        Exit Sub
    End If
    With Sheets("QH_文件修改")
        .Range("A5:E100000").ClearContents
    End With
    End Sub
    

    三、文件下载

     

    展开全文
  • 函数作用:取得一个短文件名的长文件名.............111 '109.函数作用:取得临时文件名.........................112 '110.函数作用:等用Shell调用的程序执行完成后再执行其它程序.....................................
  • '保存工作簿时,如何后一个名称不和前一个名称重复? '有很多种方法,通常会以时间命名,比如我们手机里的照片的名称一般都会有时间,很多地方都是。 '我们也可以这样命名,具体方法如下。 Sub 保存工作簿时命名() ...

    '保存工作簿时,如何后一个名称不和前一个名称重复?
    '有很多种方法,通常会以时间命名,比如我们手机里的照片的名称一般都会有时间,很多地方都是。
    '我们也可以这样命名,具体方法如下。

    Sub 保存工作簿时命名()
        ThisWorkbook.SaveAs ThisWorkbook.Path & "\另存为工作簿" & Format(Now, "yyyymmddhhmmss")
    End Sub
    

    '这里用到了秒,这样命名时一般就不会重复,这是14位的,想要短一些的话,可以把前面的若干位省略。

    展开全文
  • 'ResultFlag=0 获取路径 'ResultFlag=1 获取文件名 'ResultFlag=2 获取扩展名   Public Function SplitPath(FullPath As String, ResultFlag As Integer) As String Dim SplitPos ...
  • 一、提取单层文件内的文件名 只会提取到文件,如果是文件夹自动忽略。 Sub FileDir() Dim p$, f$, k& '获取用户选择文件夹的路径 With Application.FileDialog(msoFileDialogFolderPicker) '选择文件夹 ...
  • VBA 字符串函数&转换函数

    千次阅读 2018-12-05 16:58:09
    1,vba字符串函数列表: Trim(string) 去掉string左右两端空白 Ltrim(string) 去掉string左端空白 Rtrim(string) 去掉string右端空白 Len(string) 计算string长度 Left(string, x) 取string左段x个字符组成...
  • VBA函数定义及说明

    千次阅读 2020-06-24 11:18:28
    函数定义,函数返回对象,默认参数,不定长参数
  • vba常用函数详细介绍及示例

    千次阅读 2020-07-17 10:53:08
    Abs 函数 返回将传递给指定数字的绝对值的相同类型的值。 语法 Abs(数字) 必需的_number_ 参数可以是任何有效的数值表达式。 如果 number 包含 Null,则返回 Null;如果它是未初始化的变量,则返回 0。 数字的...
  • VBA之dir函数综合使用

    千次阅读 2020-03-30 21:13:41
    1.dir函数的有判断一个文件是否存在的功能,也可以使用通配符模糊匹配 返回的是该文件的文件名 Sub test() Dim i As Integer For i = 1 To 5 If Dir(“d:\data” & Range(“a” & i) & ".xls*) = “” ...
  • 这是一个仿api调用方式的文件查找代码,在...调用时,查到的文件直接在调用函数的参数中返回,调用时给出参数名称,函数自动返回数组结果。可以返回文件名,文件大小,创建日期,修改日期。 是在别人的代码上重建的。
  • 上一篇文章已经学习了Instr()函数,InStrRev()函数正好与Instr()函数相反,查找的方向是相反的。Instr()的查找方向是从左到右,而InStrRev()函数的方向是从右到左。 语法 InStrRev(string1, string2 [,start, ...
  • 从上一篇文章我们可以获取到指定单元格的数据,并判断出类型。 这次要做的就是,如果这个单元格数据类型是字符串,我们就去进行子字符串的匹配,说的简单点就是判断指定单元格有没有我们需要找的字符串。 例如:...
  • vba里使用python自定义函数

    千次阅读 2018-12-21 22:49:51
    今天讲一下怎么在vba里面使用python的自定义函数。在vba板块提下python主要是python的包很多。对于我们来说,直接拿轮子过来用用肯定是很好的事情,复杂的原理,背后的算法与我无关。沟通python和excel主要是通过一个名...
  • vba常用函数

    万次阅读 多人点赞 2017-07-06 16:12:25
    1,vba字符串函数列表: Trim(string) 去掉string左右两端空白 Ltrim(string) 去掉string左端空白 Rtrim(string) 去掉string右端空白 Len(string) 计算string长度 Left(string, x) 取str
  • 心得(2):如何利用VBA一键更改多个excel文件为指定的名称 问题:如何一键更改相同目录下的所有excel文件的名称,改为这个excel文件名内的每个单元格的内容,如我这个因为是要统计所有比赛队伍的信息,因为大部分人的...
  • 1.1Dir函数 语法 Dir[(pathname[,attributes])] 其中两个参数都是可选参数,也就是可以默认缺省 dir 或 dir() 返回值缺省范围为"" 返回一个String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的...
  • 6个简单而有用的VBA自定义函数

    千次阅读 2019-11-29 07:45:14
    VBA内部有许多有用的内建函数,但对于好些常规任务(或常见的问题)仍然需要编写自定义函数,这些问题是比较通用的。如检查一个文件是否存在等。 这里包括了6个非常有用自定义VBA函数,你可以简单的复制这些代码到你...
  • 1.最近对Excel文件使用较为频繁,故写了几个函数,通过调用可以实现一些基本功能,仅供参考: (1)遍历指定文件夹下所有文件,并获得文件名(如需要获得指定的文件类型,请增加一个判断条件来判断文件类型) ...
  • excel中VBA提取文件夹名称的方法

    千次阅读 2016-08-09 15:15:54
    内容提要:文章介绍excel中使用VBA代码来提取文件夹名称的具体操作步骤。对Excel感兴趣的朋友可加Excel学习交流群:284029260(www.itblw.com)  在网上看到有人用批处理命令提取文件夹名称。其实在excel中使用VBA...
  • @VBA GetOpenFilename文件类型筛选规则,返回选择的文件完整路径和文件名 一、概述基本语法 'GetOpenFilename相当于Excel打开窗口,通过该窗口选择要打开的文件,并可以返回选择的文件完整路径和文件名。 '注: 1、此...
  • 108.取得一个短文件名的长文件名 109.取得临时文件名 110.等用Shell调用的程序执行完成后再执行其它程序 111.将Mouse显示成动画 112.限制Mouse移动范围 113.取得当前激活窗品句柄及标题 114.取得屏幕分辨率 115.自动...
  • VBA 部分实用函数

    2020-08-09 21:53:35
    今天的学习课程一共是两个,一个是把昨天提到的常用的函数写一遍,另一个是学习一些新函数 一、昨天提到的相关函数 https://blog.csdn.net/Di77HaoWenMing/article/details/107886745 1.判断文件是否存在的...
  • VBA SolidWorks 二次开发 API ---从宏开始

    千次阅读 2019-09-16 13:34:05
    通过这些代码,我们可以更快更直接的找到所需要查询的API函数。我们以最简单的做一个拉伸特征开始,看如何找到对应的API 1.显示Macro工具条: 2. 点击工具条上的录制按钮,然后手动进行零件的新建,选择一个基准...
  • Sub getfoldername() '获取指定路径下的文件夹名称 Dim fs As Object n = 1 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.getfolder("C:\Lx\all") For Each fd In f.subfolders Cells(n, ...
  • VBA Dir 函数

    万次阅读 2015-12-31 14:39:36
    Dir函数 返回一个 String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。 语法 Dir[(pathname[, attributes])] Dir 函数的语法具有以下几个部分: 部分 ...
  • 1.今天用dir函数做了一个自动将文件归档的程序,我们一起来看看效果,首先,文件夹里面的文件名称如下图所示,我们可以看到所有的文件名(除我们写VBA代码的表格)都符合2020.xx.xx.xlsx的格式 2.我们要做的是将...
  • VB 用Fso函数处理带有问号的Unicode文件名  VB6 编写程序时,经常遇到文件名中含有Unicode字符的文件名,常规的Name语句,Open语句,甚至Windows 中API函数都无法处理这里的文件名,因为这些文件在VB String字符串...
  • VBA操作文件四大方法之之四-API函数

    千次阅读 2012-12-09 22:56:39
    VBA操作文件四大方法之之四-API函数   (一)处理驱动器及目录  CreateDirectory,CreateDirectoryEx 创建一个新目录  GetCurrentDirectory 在一个缓冲区中装载当前目录  GetDiskFreeSpace,...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 2,115
精华内容 846
关键字:

vba获取文件名函数