EXCEL把文件所在文件夹作为变量的代码

笑起来就会美

我有一段别人写的代码：
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then GetDirectory = fd.SelectedItems(1)
它是弹出一个对话框让你选择文件夹，然后开始遍历文件夹取里面的文件名，我现在就想让它不弹出对话框，而是直接选择代码所在文件的文件夹，请问该怎么改呢？

bajifeng

dim ipath$

ipath = thisworkbook.path '当前代码工作簿所在的路径赋值给变量ipath

或者

ipath = “D:\work\”

笑起来就会美

bajifeng 发表于 2016-1-5 21:00
dim ipath$

ipath = thisworkbook.path '当前代码工作簿所在的路径赋值给变量ipath

谢谢您！按您的方法我修改测试了，有错误，无法获取文件夹内所有文件名称了。

原全部代码如下：
Sub Fileinfo()
Sheets(1).Range("A1").Select
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then GetDirectory = fd.SelectedItems(1)
Dim c As Long, R As Long, i As Long
Dim FileName As Object, ObjShell As Object, ObiFolder As Object
Set ObjShell = CreateObject("shell.Application")
Set ObiFolder = ObjShell.Namespace(GetDirectory)
On Error Resume Next
c = 0
For i = 0 To 34
If i = 27 Or i = 28 Or i = 29 Or i = 31 Then
'
Else
c = c + 1
Cells(1, c) = ObiFolder.getdetailsof(ObiFolder.Items, i)
End If
Next i
R = 1
For Each FileName In ObiFolder.Items
c = 0
R = R + 1
For i = 0 To 34
If i = 27 Or i = 28 Or i = 29 Or i = 31 Then
'
Else
c = c + 1
Cells(R, c) = ObiFolder.getdetailsof(FileName, i)
End If
Next i
Next FileName
ActiveSheet.ListObjects.Add xlSrcRange, [A1].CurrentRegion
Set fd = Nothing

End Sub

我把第3-5句按您的建议改成了：
Dim ipath$
ipath = ThisWorkbook.path '当前代码工作簿所在路径赋值给变量ipath
If ipath = -1 Then GetDirectory = ipath.SelectedItems(1)

就无法获取文件名了

还请您再指点，谢谢！

笑起来就会美

bajifeng 发表于 2016-1-5 21:00
dim ipath$

ipath = thisworkbook.path '当前代码工作簿所在的路径赋值给变量ipath

谢谢您的回复！
我修改后，虽然不弹出对话框了，但是也无法获取文件夹内的文件名了。

Dim ipath$
ipath = ThisWorkbook.path '当前代码工作簿所在路径赋值给变量ipath
If ipath = -1 Then GetDirectory = ipath.SelectedItems(1)

笑起来就会美

bajifeng 发表于 2016-1-5 21:00
dim ipath$

ipath = thisworkbook.path '当前代码工作簿所在的路径赋值给变量ipath

原代码如下：
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then GetDirectory = fd.SelectedItems(1)

Dim c As Long, R As Long, i As Long
Dim FileName As Object, ObjShell As Object, ObiFolder As Object
Set ObjShell = CreateObject("shell.Application")
Set ObiFolder = ObjShell.Namespace(GetDirectory)
On Error Resume Next
c = 0
For i = 0 To 34
If i = 27 Or i = 28 Or i = 29 Or i = 31 Then
'
Else
c = c + 1
Cells(1, c) = ObiFolder.getdetailsof(ObiFolder.Items, i)
End If
Next i
R = 1
For Each FileName In ObiFolder.Items
c = 0
R = R + 1
For i = 0 To 34
If i = 27 Or i = 28 Or i = 29 Or i = 31 Then
'
Else
c = c + 1
Cells(R, c) = ObiFolder.getdetailsof(FileName, i)
End If
Next i
Next FileName
ActiveSheet.ListObjects.Add xlSrcRange, [A1].CurrentRegion
Set fd = Nothing