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 fileChekFlgIf Sheet1.Range("D10").Value = "" ThenfileChekFlg = 1End IfIf Sheet1.Range("D10").Value <> "" ThenfileChekFlg = 0End If'ファイル名チェックフラグDim flgflg = 0Dim fileNameIsNcountfileNameIsNcount = 0Dim projectAllName As StringCall getProjectName(projectAllName)Dim index As IntegerDim sourceStrDim resultStrindex = 18sourceStr = "D"resultStr = "I"sourceStr = sourceStr + CStr(index)resultStr = resultStr + CStr(index)Do While Sheet1.Range(sourceStr).Value <> ""'#####################################################Dim allPath As String'ファイル名Dim fileName As StringfileName = Sheet1.Range(sourceStr).Value'#########If fileChekFlg = 1 Then'ファイル名チェックフラグflg = 0Call fileNameCheck(fileName, flg)If flg = 1 ThenSheet1.Range(resultStr).Value = Trim("n件の可能性があります、抽出なし。「全パス検索」を利用してください！")fileNameIsNcount = fileNameIsNcount + 1End IfEnd If'#########'#########If flg <> 1 ThenCall getFileAllPath(allPath, fileName, projectAllName)Dim usefulPath As StringCall getThePathWeNeed(allPath, usefulPath)'####################################################'Excelの中に表示するSheet1.Range(resultStr).Value = Trim(usefulPath)End If'#########index = index + 1sourceStr = "D"sourceStr = sourceStr + CStr(index)resultStr = "I"resultStr = resultStr + CStr(index)fileName = ""allPath = ""usefulPath = ""LoopIf fileNameIsNcount <> 0 ThenSheet1.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 = "" ThenprojectPathStr = Sheet1.Range("D3").Value + "\" + projectAllName
End If'パス全部自分定義入力して
If Sheet1.Range("D10").Value <> "" ThenprojectPathStr = 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終了のIndexDim endIndex'一行一行取得するbatReturnStr = oStdOut.ReadLine'「 のディレクトリ」はほうしいの行の中に含むの文字です。'例：「 C:\sxz\workspace\comp1-PC\commonSources\jp\co\mycard\na\web\US\AAA01\blogic のディレクトリ」endIndex = InStr(batReturnStr, " のディレクトリ")If endIndex <> 0 ThenallPath = Mid(batReturnStr, 1, endIndex - 1) + "\" + fileNameEnd IfLoop
'ループ終了End Sub'###########################################
'#
'# The path we need
'#
'###########################################
Sub getThePathWeNeed(ByVal allPath As String, ByRef usefulPath As String)
'パスの中に「C:\flarestarAtu\workspace」 この部分を削除する
Dim indexOf_workspaceindexOf_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 kaishyaNameDim projectNamekaishyaName = Sheet1.Range("B8").ValueprojectName = Sheet1.Range("D8").ValuekaishyaName = Split(kaishyaName, "_")(0)projectName = Split(projectName, "_")(0)Call getProjectNameWithIndex(CInt(kaishyaName), CInt(projectName), name)'MsgBox nameEnd 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 = 0For i = 1 To 6 Step 1If fileName = fileNames(i) Thenflg = 1Exit ForEnd If
NextEnd 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

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

Excel VBA实现通过文件名查找全路径相关推荐

vba不能提取服务器上文件名,从全路径文件名中获取文件名（不含路径）
从全路径文件名中获取文件名(不含路径) 方法一: Public Function gf_GetFileName(strFullPath As String) As String Dim splitLi ...
Excel VBA批量修改文件名
一.设计思路 1.选择要修改文件的文件夹: 2.获取文件夹内所有文件: 3.在Excel里面将文件改后名写好: 4.更改文件名: 5.清空数据: 二.代码实现 1.可视化选择文件夹代码 With Ap ...
ubuntu知道文件名查找文件路径
安装locate 依次运行 sudo apt install mlocate和sudo updatedb即可. 使用 lacate 文件名例子:locate site-packages
linux根据文件名查找文件路径
以查找"dubbo-consumer.xml"为例方法一:当前文件夹下操作 find ./ -name dubbo-consumer.xml 结果: 方法二:未知准确文件夹查找 ...
Excel VBA高级编程-关键字查找数据库
关注公众号:万能的Excel 并回复[关键字]获取源文件! 功能说明: 这个表格的主要功能是:根据输入的关键字找到数据库中,正确的公司名,生成一个下拉菜单,再根据正确的公司名,找到对应的No生 ...
【Excel】VBA批量修改文件名
Excel:VBA批量修改文件名 Dim filePath As Variant '定义filepath为变量 Dim obj As Object '定义obj为变量对象 Dim fld, ff, g ...
在指定路径或者是文件名查找指定的字符串
分享一下我老师大神的人工智能教程!零基础,通俗易懂!http://blog.csdn.net/jiangjunshow 也欢迎大家转载本篇文章.分享知识,造福人民,实现我们中华民族伟大复兴! 采用WI ...
提取文件名+复制+改名+批量创建文件程序（Excel VBA版）
用Excel VBA做了个文件处理小工具,集合了文件名提取.文件复制.改名及批量创建文件.搜索复制文件的功能. (注:如果是规则改名,建议使用拖把更名器,使用起来更直观,下载链接中附拖把更名器程序) ...
linux 内核 struct file 获取文件名全路径
获取文件名: struct file *filp; filp->f_path.dentry->d_iname 获取全路径: dentry_path_raw(filp->f_path. ...

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

Excel VBA实现通过文件名查找全路径相关推荐

最新文章

热门文章

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

Excel VBA实现 通过文件名查找全路径相关推荐

最新文章

热门文章

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

Excel VBA实现通过文件名查找全路径相关推荐