Vbscript 将文件名读入数组或字典以用作用户输入_Vbscript

Vbscript 将文件名读入数组或字典以用作用户输入

vbscript

Vbscript 将文件名读入数组或字典以用作用户输入,vbscript,Vbscript,我希望有一个脚本，读取特定文件夹并提取基本文件名，删除最后两个字符，然后使用结果填充inputbox的文本。然后，用户从给定的选项中进行选择，脚本的其余部分将搜索第二个文件夹中的文本，并将其替换为所选文本。初始目标文件夹中的文件名示例： ABFA1 ABFA3 ABFA4 HVA1 HVA3 HVA4 ITALA1 ITALA3 ITALA4 显然，一旦最后2个字符被删除，我将需要删除重复的字符。以下是我到目前为止的部分脚本： Set objFSO = CreateObject("Scrip

我希望有一个脚本，读取特定文件夹并提取基本文件名，删除最后两个字符，然后使用结果填充inputbox的文本。然后，用户从给定的选项中进行选择，脚本的其余部分将搜索第二个文件夹中的文本，并将其替换为所选文本。初始目标文件夹中的文件名示例：

ABFA1
ABFA3
ABFA4
HVA1
HVA3
HVA4
ITALA1
ITALA3
ITALA4

显然，一旦最后2个字符被删除，我将需要删除重复的字符。以下是我到目前为止的部分脚本：

Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = objFSO.BuildPath(objFSO.GetAbsolutePathName("."), "\dwgs\logos")  
If Not objFSO.FolderExists(strFilePath) Then
  wscript.echo("Folder does not exist, script exiting")
  wscript.quit
End if
'
Set objFolder = objFSO.GetFolder (strFilePath)
For Each objFile In objFolder.Files
 strFile = objFSO.GetBaseName(objFile.Name)
  strFile = LEFT(strFile, (LEN(strFile)-2))
'   wscript.echo(strFile)           
    Next

'delete all duplicate files names and add result to dictionary (or array?)

'create an inputbox and present a number of choices populated by the dictionary/array

user1 = InputBox("Select a Logo:"&(chr(13))&(chr(13))&(*array/dict*)), "Logo Replacement Script")

' Set arguments
strFilePath2 = objFSO.BuildPath(objFSO.GetAbsolutePathName("."), "\dwgs")
FindString = "dwgs\logos\"
ReplaceStringWith = "dwgs\logos\"&(user1)

' Find and replace function

我能够在删除最后2个字符后获得基本文件名，但我不知道如何删除重复的文件名，然后在输入框中使用结果？（我想象输入框中的文本是一个数字，后跟一个选项，用户输入数字表示要使用哪个选项）我的第一个想法是使用数组，但经过一些阅读，似乎字典方法可能更好。不幸的是，我还没有弄明白如何将它合并到脚本中。任何帮助都将不胜感激

包含Ekkehard输入的更新脚本：

Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = objFSO.BuildPath(objFSO.GetAbsolutePathName("."), "\dwgs\logos")  
'
Function ShowFilesInFolder(strFolderPath)
    Set oFolder = objFSO.GetFolder(strFolderPath)
    Set oFileCollection = oFolder.Files 
    For Each oTempFile in oFileCollection
        strTemp = strTemp & oTempFile.name 
        strTemp = LEFT(strTemp, (LEN(strTemp)-6))
    Next
    ShowFilesInFolder = strTemp
 End Function 
x = ShowFilesInFolder(strFilePath)
'
Function mkDic(aK, aV)
  Dim tmp : Set tmp = CreateObject("Scripting.Dictionary")
  Dim i
  For i = 0 To UBound(aK)
      tmp(aK(i)) = aV(i)
  Next
  Set mkDic = tmp
 End Function
'
 Dim a : a = Split (x)
 WScript.Echo Join(mkDic(a, a).Keys)

出于某种原因，我无法使用mkDic函数从ShowFilesInFolder函数中分割输入？

有没有比我想到的更简单的方法呢？

用于唯一性的VBScript工具非常有用。此演示（参见）

输出：

cscript 45590698.vbs
ABFA1 ABFA3 ABFA4 HVA1 HVA3 HVA4 ITALA1 ITALA3 ITALA4
ABF HV ITAL => ABFA4 HVA4 ITALA4

演示了如何消除重复数组以及如何将（唯一）键串接到提示中。

我设法获得了一个工作脚本，但如果不使用两个临时文本文件来传递数据，就无法找到如何执行该操作。我想我会发布代码，以防对某人有所帮助

Const ForReading = 1, ForWriting = 2, ForAppending = 8, N = 0
Set fso = CreateObject("Scripting.FileSystemObject")
strFilePath = fso.BuildPath(fso.GetAbsolutePathName("."), "\dwgs\logos")
If Not fso.FolderExists(strFilePath) Then
  wscript.echo("The LOGO Folder Does Not Exist - Exiting Script")
  wscript.quit
End if
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForWriting, True)
Set objShell = CreateObject ("Shell.Application")
Set objFolder = objShell.Namespace (strFilePath)
For Each strFileName in objFolder.Items
a = objFolder.GetDetailsOf (strFileName, N)
a = LEFT(a, (LEN(a)-6))
f.Writeline (a)
Next
f.Close
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading)              
TheFile = f.ReadAll
f.Close
'
Function mkDic(aK, aV)
  Dim tmp : Set tmp = CreateObject("Scripting.Dictionary")
  Dim i
  For i = 0 To UBound(aK)
      tmp(aK(i)) = aV(i)
  Next
  Set mkDic = tmp
 End Function
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForWriting, True)
 Dim a : a = Split(TheFile,vbcrlf)
 a = Join(mkDic(a, a).Keys)
 f.Writeline (a)
f.Close
'
Set f = fso.OpenTextFile("xtempLogos2.txt", ForWriting, True)
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading)
theFile = f.ReadAll
number = 1
myArray = Split(theFile)
for i = 0 to Ubound(MyArray)-1
Set f = fso.OpenTextFile("xtempLogos2.txt", ForAppending, True)
If number < 10 then f.Writeline (number) & ".........." & myArray(i)
If number >=10 then f.Writeline (number) & "........." & myArray(i)
f.Writeline ""
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading, True)
number=number+1
Next
f.Close
'
Set f = fso.OpenTextFile("xtempLogos2.txt", ForReading)             
TheFile = f.ReadAll
f.Close
'
user1 = InputBox("WHICH LOGO DO YOU WANT TO ADD?"&(chr(13))&(chr(13))&(chr(13))& (theFile), "Add Logo Script", 11)
choice = (user1) - 1
wscript.echo myArray(choice)
'
Set f = fso.GetFile("xtempLogos.txt")
f.Delete
Set f = fso.GetFile("xtempLogos2.txt")
f.Delete

Const for reading=1，for write=2，for appending=8，N=0
设置fso=CreateObject（“Scripting.FileSystemObject”）
strFilePath=fso.BuildPath（fso.GetAbsolutePathName（“.”，“\dwgs\logos”）
如果不存在fso.FolderExists（strFilePath），则
echo（“徽标文件夹不存在-正在退出脚本”）
wscript.quit
如果结束
'
设置f=fso.OpenTextFile（“xtempLogos.txt”，用于写入，True）
设置objShell=CreateObject（“Shell.Application”）
设置objFolder=objShell.Namespace（strFilePath）
对于objFolder.Items中的每个strFileName
a=objFolder.GetDetailsOf（strFileName，N）
a=左（a，（透镜（a）-6））
f、 写线（a）
下一个
f、 接近
'
设置f=fso.OpenTextFile（“xtempLogos.txt”，用于读取）
TheFile=f.ReadAll
f、 接近
'
功能mkDic（aK、aV）
Dim tmp:Set tmp=CreateObject（“Scripting.Dictionary”）
昏暗的我
对于i=0至UBound（aK）
tmp（aK（i））=aV（i）
下一个
设置mkDic=tmp
端函数
'
设置f=fso.OpenTextFile（“xtempLogos.txt”，用于写入，True）
尺寸a:a=拆分（文件，vbcrlf）
a=连接（mkDic（a，a）.键）
f、 写线（a）
f、 接近
'
设置f=fso.OpenTextFile（“xtempLogos2.txt”，用于写入，True）
设置f=fso.OpenTextFile（“xtempLogos.txt”，用于读取）
theFile=f.ReadAll
数字=1
myArray=拆分（文件）
对于i=0到Ubound（MyArray）-1
设置f=fso.OpenTextFile（“xtempLogos2.txt”，用于显示，True）
如果数字小于10，则f.Writeline（数字）&“…”和myArray（i）
如果数字>=10，则f.Writeline（数字）&“…”和myArray（i）
f、 写线“
设置f=fso.OpenTextFile（“xtempLogos.txt”，ForReading，True）
数字=数字+1
下一个
f、 接近
'
设置f=fso.OpenTextFile（“xtempLogos2.txt”，用于读取）
TheFile=f.ReadAll
f、 接近
'
user1=InputBox（“要添加哪个徽标？”&（chr（13））&（chr（13））&（chr（13））&（chr（13））&（文件），“添加徽标脚本”，11）
选项=（user1）-1
wscript.echo myArray（选项）
'
Set f=fso.GetFile（“xtempLogos.txt”）
f、 删除
Set f=fso.GetFile（“xtempLogos2.txt”）
f、 删除

感谢您的输入。当我使用提供的函数时，它工作得很好，但是当我试图通过变量传递信息时，它似乎没有按预期工作（并且没有拆分元素）。我已经更新了脚本方面的内容。如有进一步了解，将不胜感激。

Const ForReading = 1, ForWriting = 2, ForAppending = 8, N = 0
Set fso = CreateObject("Scripting.FileSystemObject")
strFilePath = fso.BuildPath(fso.GetAbsolutePathName("."), "\dwgs\logos")
If Not fso.FolderExists(strFilePath) Then
  wscript.echo("The LOGO Folder Does Not Exist - Exiting Script")
  wscript.quit
End if
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForWriting, True)
Set objShell = CreateObject ("Shell.Application")
Set objFolder = objShell.Namespace (strFilePath)
For Each strFileName in objFolder.Items
a = objFolder.GetDetailsOf (strFileName, N)
a = LEFT(a, (LEN(a)-6))
f.Writeline (a)
Next
f.Close
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading)              
TheFile = f.ReadAll
f.Close
'
Function mkDic(aK, aV)
  Dim tmp : Set tmp = CreateObject("Scripting.Dictionary")
  Dim i
  For i = 0 To UBound(aK)
      tmp(aK(i)) = aV(i)
  Next
  Set mkDic = tmp
 End Function
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForWriting, True)
 Dim a : a = Split(TheFile,vbcrlf)
 a = Join(mkDic(a, a).Keys)
 f.Writeline (a)
f.Close
'
Set f = fso.OpenTextFile("xtempLogos2.txt", ForWriting, True)
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading)
theFile = f.ReadAll
number = 1
myArray = Split(theFile)
for i = 0 to Ubound(MyArray)-1
Set f = fso.OpenTextFile("xtempLogos2.txt", ForAppending, True)
If number < 10 then f.Writeline (number) & ".........." & myArray(i)
If number >=10 then f.Writeline (number) & "........." & myArray(i)
f.Writeline ""
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading, True)
number=number+1
Next
f.Close
'
Set f = fso.OpenTextFile("xtempLogos2.txt", ForReading)             
TheFile = f.ReadAll
f.Close
'
user1 = InputBox("WHICH LOGO DO YOU WANT TO ADD?"&(chr(13))&(chr(13))&(chr(13))& (theFile), "Add Logo Script", 11)
choice = (user1) - 1
wscript.echo myArray(choice)
'
Set f = fso.GetFile("xtempLogos.txt")
f.Delete
Set f = fso.GetFile("xtempLogos2.txt")
f.Delete