Excel VBA实现 通过文件名查找全路径

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

==========================================