求教大神利用VBA在CAD中打开CAD相应文件夹下的excel

906379829

Set xlbook = xlapp.workbooks.Open("C:\Users\Administrator\Desktop\块属性导入EXCEL实验\2017年模板(农网物资含税）.xls") '打开的EXCEL路径

这句话是打开固定位置的excel，如何改为打开CAD文件夹下的excel呢，CAD位置不固定

nslove44202489

thisdrawing.path

pengfei2010

回帖是一种美德！感谢楼主的无私分享 谢谢

3xxx

cad指的是cad的安装目录还是你的cad图纸所在文件夹？

fjfhgdwfn

加上浏览对话框就行吧

vbcad

Private Type BROWSEINFO
   hwndOwner As Long
   pidlRoot As Long
   pszDisplayName As Long
   lpszTitle As Long
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBi As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Sub Command1_Click()
Dim j As Long, strXlsFileName As String
Dim strPath As String, FileName As String, ExtName As String
ExtName = ".xls" '指定要查找的文件扩展名
strPath = App.Path & "\"   ' 指定路径为当前脚本目录。
strPath = BrowseForFolder '‘ "E:\资料\"
If Len(strPath) = 0 Then Exit Sub
FileName = Dir(strPath, vbNormal) ' 找寻第一项。
Do While FileName <> "" ' 开始循环。

    If InStr(LCase(FileName), ExtName) Then '如果MyName中的扩展名是XLS则打开表格文件
        j = j + 1
        strXlsFileName = strXlsFileName & vbCrLf & FileName
    End If
    FileName = Dir ' 查找下一个
Loop
MsgBox "找到xls文件" & j & "个" & vbCrLf & strXlsFileName
End Sub
'选择文件夹对话框
'函数:BrowseForFolder
Public Function BrowseForFolder(Optional sPrompt As String = "") As String
   
  '定义变量
   Dim iNull As Integer
   Dim lpIDList As Long
   Dim lResult As Long
   Dim sPath As String
   Dim udtBi As BROWSEINFO
  '初始化.....
   With udtBi
    .hwndOwner = 0
    .lpszTitle = lstrcat(sPrompt, "")
    .ulFlags = 1
   End With

  '调用API
   lpIDList = SHBrowseForFolder(udtBi)
  '得到返回结果
  If lpIDList Then
    sPath = String$(MAX_PATH, 0)
    lResult = SHGetPathFromIDList(lpIDList, sPath)
    Call CoTaskMemFree(lpIDList)
    iNull = InStr(sPath, vbNullChar)
    If iNull Then sPath = Left$(sPath, iNull - 1)
   End If
   BrowseForFolder = sPath

End Function

906379829

好久没逛帖子了，谢谢各位