Excel VBA實現 通過檔名查詢全路徑
阿新 • • 發佈:2019-01-04
VBA
提供一組檔名,得到所有檔案的相對於工程的目錄(版本1.5)
呼叫bat實現
#mode con cols=15 lines=1
set fileName=%1%
set projectPath=%2%
cd %projectPath%
dir/a/s %filename%
Private Sub CommandButton1_Click() 'MsgBox "begin" 'ファイル名チェック必要かどうかフラグ Dim fileChekFlg If Sheet1.Range("D10").Value = "" Then fileChekFlg = 1 End If If Sheet1.Range("D10").Value <> "" Then fileChekFlg = 0 End If 'ファイル名チェックフラグ Dim flg flg = 0 Dim fileNameIsNcount fileNameIsNcount = 0 Dim projectAllName As String Call getProjectName(projectAllName) Dim index As Integer Dim sourceStr Dim resultStr index = 18 sourceStr = "D" resultStr = "I" sourceStr = sourceStr + CStr(index) resultStr = resultStr + CStr(index) Do While Sheet1.Range(sourceStr).Value <> "" '##################################################### Dim allPath As String 'ファイル名 Dim fileName As String fileName = Sheet1.Range(sourceStr).Value '######### If fileChekFlg = 1 Then 'ファイル名チェックフラグ flg = 0 Call fileNameCheck(fileName, flg) If flg = 1 Then Sheet1.Range(resultStr).Value = Trim("n件の可能性があります、抽出なし。「全パス検索」を利用してください!") fileNameIsNcount = fileNameIsNcount + 1 End If End If '######### '######### If flg <> 1 Then Call getFileAllPath(allPath, fileName, projectAllName) Dim usefulPath As String Call getThePathWeNeed(allPath, usefulPath) '#################################################### 'Excelの中に表示する Sheet1.Range(resultStr).Value = Trim(usefulPath) End If '######### index = index + 1 sourceStr = "D" sourceStr = sourceStr + CStr(index) resultStr = "I" resultStr = resultStr + CStr(index) fileName = "" allPath = "" usefulPath = "" Loop If fileNameIsNcount <> 0 Then Sheet1.Range("D10").Value = "例:「C:\sxz\workspace\Batch-comp1\conf\list\sequential\SSSBLC01」" End If 'MsgBox "end" End Sub '########################################### '# '# 全パスを取得する '# '########################################### Sub getFileAllPath(ByRef allPath As String, ByVal fileName As String, ByVal projectAllName As String) '工程パス Dim projectPathStr 'パスは選択作成した If Sheet1.Range("D10").Value = "" Then projectPathStr = Sheet1.Range("D3").Value + "\" + projectAllName End If 'パス全部自分定義入力して If Sheet1.Range("D10").Value <> "" Then projectPathStr = Sheet1.Range("D10").Value End If 'bat命令 Dim cmdStr cmdStr = "cmd /c D:\bat\getAllPathWithFileName.bat " + fileName + " " + projectPathStr 'バッチを実行する RetVal = Shell(cmdStr) 'バッチを実行する(返卻値を取得できます) Set WshShell = CreateObject("WScript.Shell") Set oExec = WshShell.Exec(cmdStr) Set oStdOut = oExec.StdOut 'バッチの返卻値 Dim batReturnStr 'バッチ返卻値のループ開始 Do Until oStdOut.AtEndOfStream 'ほうしいの返卻値を取得する。 'パス含むのstr終了のIndex Dim endIndex '一行一行取得する batReturnStr = oStdOut.ReadLine '「 のディレクトリ」はほうしいの行の中に含むの文字です。 '例:「 C:\sxz\workspace\comp1-PC\commonSources\jp\co\mycard\na\web\US\AAA01\blogic のディレクトリ」 endIndex = InStr(batReturnStr, " のディレクトリ") If endIndex <> 0 Then allPath = Mid(batReturnStr, 1, endIndex - 1) + "\" + fileName End If Loop 'ループ終了 End Sub '########################################### '# '# The path we need '# '########################################### Sub getThePathWeNeed(ByVal allPath As String, ByRef usefulPath As String) 'パスの中に「C:\flarestarAtu\workspace」 この部分を削除する Dim indexOf_workspace indexOf_workspace = InStr(allPath, "workspace") 'The path we need usefulPath = Mid(allPath, indexOf_workspace + 9, Len(allPath)) usefulPath = Replace(usefulPath, "\", "/") End Sub '###################################### '# '# 選択したの値対応のindexを取得する '# '########################################### Sub getProjectName(ByRef name As String) Dim kaishyaName Dim projectName kaishyaName = Sheet1.Range("B8").Value projectName = Sheet1.Range("D8").Value kaishyaName = Split(kaishyaName, "_")(0) projectName = Split(projectName, "_")(0) Call getProjectNameWithIndex(CInt(kaishyaName), CInt(projectName), name) 'MsgBox name End Sub '###################################### '# '# 選択値より、工程名を取得する '# '########################################### Sub getProjectNameWithIndex(kaishyaIndex As Integer, projectIndex As Integer, ByRef name As String) Dim progectNames(1 To 10, 1 To 4) progectNames(1, 1) = "comp_1_PC" progectNames(2, 1) = "comp_2_PC" progectNames(3, 1) = "comp_3_PC" progectNames(4, 1) = "comp_4_PC" progectNames(5, 1) = "comp_5_PC" progectNames(6, 1) = "comp_6_PC" progectNames(7, 1) = "comp_7_PC" progectNames(8, 1) = "comp_8_PC" progectNames(9, 1) = "comp_9_PC" progectNames(10, 1) = "comp_10_PC" progectNames(1, 2) = "comp_1_MB" progectNames(2, 2) = "comp_2_MB" progectNames(3, 2) = "comp_3_MB" progectNames(4, 2) = "comp_4_MB" progectNames(5, 2) = "comp_5_MB" progectNames(6, 2) = "comp_6_MB" progectNames(7, 2) = "comp_7_MB" progectNames(8, 2) = "comp_8_MB" progectNames(9, 2) = "comp_9_MB" progectNames(10, 2) = "comp_10_MB" progectNames(1, 3) = "comp_1_AD" progectNames(2, 3) = "comp_2_AD" progectNames(3, 3) = "comp_3_AD" progectNames(4, 3) = "comp_4_AD" progectNames(5, 3) = "comp_5_AD" progectNames(6, 3) = "comp_6_AD" progectNames(7, 3) = "comp_7_AD" progectNames(8, 3) = "comp_8_AD" progectNames(9, 3) = "comp_9_AD" progectNames(10, 3) = "comp_10_AD" progectNames(1, 4) = "comp_1_Batch" progectNames(2, 4) = "comp_2_Batch" progectNames(3, 4) = "comp_3_Batch" progectNames(4, 4) = "comp_4_Batch" progectNames(5, 4) = "comp_5_Batch" progectNames(6, 4) = "comp_6_Batch" progectNames(7, 4) = "comp_7_Batch" progectNames(8, 4) = "comp_8_Batch" progectNames(9, 4) = "comp_9_Batch" progectNames(10, 4) = "comp_10_Batch" name = progectNames(kaishyaIndex, projectIndex) End Sub '###################################### '# '# file name check '# '########################################### Sub fileNameCheck(ByVal fileName, ByRef flg) Dim fileNames(1 To 6) fileNames(1) = "seq-def-data.xml" fileNames(2) = "seq-def-end.xml" fileNames(3) = "seq-def-header.xml" fileNames(4) = "seq-def-trailer.xml" fileNames(5) = "seq-line-def.dtd" fileNames(6) = "seq-line-defs.dtd" flg = 0 For i = 1 To 6 Step 1 If fileName = fileNames(i) Then flg = 1 Exit For End If Next End Sub
核心程式碼 ;
==========================================
'bat命令
Dim cmdStr
cmdStr = "cmd /c D:\bat\getAllPathWithFileName.bat " + fileName + " " + projectPathStr
'バッチを実行する
RetVal = Shell(cmdStr)
'バッチを実行する(返卻値を取得できます)
Set WshShell = CreateObject("WScript.Shell")
Set oExec = WshShell.Exec(cmdStr)
Set oStdOut = oExec.StdOut
==========================================