如何提取工作簿的名称

wangzhongtu · 发表于 2009-10-2 23:13

如何将文件夹5里面的所有文件的文件名提取到B列

taller · 发表于 2009-10-2 23:59

Private Sub CommandButton1_Click()
Dim myPath, myName
myPath = ThisWorkbook.Path & "\*.xls"
myName = Dir(myPath)
Do While myName <> ""
Sheet1.[b65536].End(xlUp).Offset(1, 0) = myName
’ 如果不需要当前工作簿名称，改用下面的这个代码
‘ If myName <> ThisWorkbook.Name Then Sheet1.[b65536].End(xlUp).Offset(1, 0) = myName
myName = Dir()
Loop
End Sub

复制代码

zhaogang1960 · 发表于 2009-10-3 00:09

不包含本工作簿名，请测试：
Sub Macro1()
Dim arr(), myPath$, myFile$, m As Integer
Application.ScreenUpdating = False
myPath = ThisWorkbook.Path & "\"
myFile = Dir(myPath & "*.xls")
Do While myFile <> ""
      If myFile <> ThisWorkbook.Name Then
         m = m + 1
         ReDim Preserve arr(1 To 2, 1 To m)
         arr(1, m) = m
         arr(2, m) = Split(myFile, ".")(0)
      End If
      myFile = Dir
Loop
ActiveSheet.UsedRange.Offset(1, 0).ClearContents
[a2].Resize(m, 2) = WorksheetFunction.Transpose(arr)
Application.ScreenUpdating = True
End Sub

如饥似渴 · 发表于 2009-10-3 07:57

2楼 taller 先生，您好！
能告诉怎样使用吗？把代码放在工作表的代码区，然后重新启动工作薄，不见效果，为什么？如果能改写成一打开“工作薄。xls”就能见到效果不是更好吗？请赐教。

sincerityyyz · 发表于 2009-10-3 08:10

把代码放到工作表的Open事件中即可！

szqhb · 发表于 2009-10-3 09:16

2、3楼的方法都可以，需设置一个按钮激活宏
2楼的代码不小心激活宏会重复提取
3楼好，且有序号

高玉甫 · 发表于 2009-10-3 09:19

3楼 zhaogang1960  先生，您好！
您在凌晨还在为新手们解答问题，深为感动，我们这些新手由衷地谢谢您，并祝您中秋快乐！
您在 3 楼写的代码我把它放到工作表的Open事件中，很好，如附件“文件夹”的“02”，这也是我长期以来想解决而没有答案的问题，谢谢您的帮助。
但是，您在 3 楼的代码还不能完全解决我的问题，请大侠在您 3 楼代码的基础上添加几句代码，帮助我了却如下的愿望：
1.  打开工作薄，文件夹中的工作薄就自动在“工作薄登记”的“02”中形成目录(您在3楼的代码已经实现)；
2.  “工作薄登记”的“02”中的工作薄名称自动生成“超链接”，即，只要点击目录中某工作薄名称，这个工作薄就会自动打开。这一点要求请大侠帮忙实现，谢谢您。
大侠实现后，请在附件中测试，并将成功的附件回传，如何，谢谢您！
祝 zhaogang1960 先生中秋快乐，全家幸福安康！

taller · 发表于 2009-10-3 09:37

原帖由 szqhb 于 2009-10-3 09:16 发表
2、3楼的方法都可以，需设置一个按钮激活宏
2楼的代码不小心激活宏会重复提取
3楼好，且有序号

能否仔细说说为什么2楼代码会重复提取吗？

zhaogang1960 · 发表于 2009-10-3 10:40

请测试：
Private Sub Workbook_Open()
Dim myPath$, myFile$, m As Integer
Application.ScreenUpdating = False
myPath = ThisWorkbook.Path & "\"
myFile = Dir(myPath & "*.xls")
m = 1
With Sheets("02")
      .UsedRange.Offset(1, 0).Clear
      Do While myFile <> ""
         If myFile <> ThisWorkbook.Name Then
            m = m + 1
            .Hyperlinks.Add Anchor:=.Cells(m, 2), Address:=myPath & myFile, TextToDisplay:=Split(myFile, ".")(0)
         End If
         myFile = Dir
      Loop
      .Range("A2").Value = 1
      If m > 2 Then .Range("A2").AutoFill Destination:=.Range("A2").Resize(m - 1), Type:=xlFillSeries
End With
Application.ScreenUpdating = True
End Sub

wangzhongtu · 发表于 2009-10-3 11:31

哇高手都来光临过啦太棒了
有人说2楼的代码有重复我看了下提出问题的朋友是这样认为的: 第一次执行命令时非常成功 ,第二次执行命令时会在原复制好的名称下面重新再复制一遍,
即点N次就会出现同一工作表名有N个

		自动登录	找回密码
密码			免费注册

[求助] 如何提取工作簿的名称

回复 2楼 taller 的帖子

回复 3楼 zhaogang1960 的帖子

回复 7楼高玉甫的帖子

浏览过的版块

[求助] 如何提取工作簿的名称

回复 2楼 taller 的帖子

回复 3楼 zhaogang1960 的帖子

回复 7楼 高玉甫 的帖子

浏览过的版块

回复 7楼高玉甫的帖子