ExcelVBA + SolidWork API 入門(自動轉DWG檔)(3)

fang9595

此篇將與SolidWorks API無關，但作成之工具，將可查詢任一資料夾中某一副檔案。
其中程式撰寫將不多作說明。
Step1:點擊"列出資料夾中的*.slddrw"之Buttom。
Step2:撰寫程式碼如下：

Private Sub CommandButton1_Click()      '查詢某路徑所有副檔名，列出至儲存格

    Dim sFile As String                 '檔名
    Dim sExFileName As String           '副檔名
    Dim sPathFileName As String         '路徑與檔名

    sFile = Range("B1").Value             '定義儲存格
    sExFileName = Range("ExFileName").Value     '定義儲存格
    sPathFileName = sFile & "\" & sExFileName   '預查詢路徑中之副檔名
    sFile = Dir(sPathFileName, 0)
   
    Dim sVar As String, rVat As String, FileNo1 As Integer, FileNo As Integer

   
    Dim i As Integer
    i = 0
    Dim nNowRow As Integer                      '最後一編輯列
    Call NotSpaceRow("A", nNowRow)
    Do While Len(sFile)
        If sFile <> "." And sFile <> ".." Then  ' 當檔案名稱不等於 "." 或 ".."
            Cells(nNowRow + i, 1).Value = Range("B1").Value & "\"
            Cells(nNowRow + i, 2).Value = sFile
            i = i + 1
        End If
        sFile = Dir
    Loop
    Cells(nNowRow + i, 1).Select

End Sub

Step3:插入一模組，撰寫一查詢最後一列之工具"NotSpaceRow()"
程式碼如下：

Option Explicit                                   '強制宣告
Const maxRowCount = 65536           'excel 2003最後一列為65536，2007版可自行變更。
Sub NotSpaceRow(s_Column As String, n_Count As Integer)  '存查現在位址
    Dim myRange As Range
    Dim sLastRange As String
    sLastRange = s_Column & maxRowCount
    Set myRange = ActiveWorkbook.ActiveSheet.Range(sLastRange).End(xlUp) '由某一行最後一列往上選取
    myRange.Offset(1, 0).Select                                          '往下一列OFFSET
    n_Count = ActiveCell.Row
    Set myRange = Nothing
End Sub

試著查詢看看各路徑與各種檔案類型。
附件範例檔：

gt.adan

回復 1# fang9595


只是查詢檔案就要寫這麼多啊？
小弟不會寫程式…看完之後更覺得軟體開發者的厲害…
謝謝大大分享

可惜檔案裏面沒有 含巨集的程式...

讲了这么久为何没有发可以转dwg的excel宏呢？

那位兄弟能直接编一个这样的excel宏发上来呀？