.vbs 帮助我在目录中循环它

发布于 2024-09-17 11:42:27 字数 1707 浏览 3 评论 0原文

我写了一个有效的脚本。它现在所做的是遍历目录查找给定文件并返回第二行第四个选项卡 (RXC193) 上的内容,并将该文件重命名为从文件中找到的文件,如下所示:

@Program @RxBIN @RXPCN @ RxGroup @MemberID @WebsiteE @WebsiteS @VerticalLogo @TextLogo
RXCUT 013824 RXCUT RXC193 RXC5FHXF9 www.rxcut.com/HBG www.rxcut.com/HBG/es P:\RxCut\In Design Implement\RXC193

我需要这个脚本能够做的是循环遍历目录并重命名所有文件通过这个 RXC#####。这是脚本:

Call TwoDimensionArrayTest

Sub TwoDimensionArrayTest
' Version 1.0
' Writtem by Krystian Kara
' Dated 25-Jan-2009


    Dim fso
    Dim oFile
    Dim arrline
    Dim arrItem
    Dim objFolder
    Dim i
    Dim arrMain()
    Dim sFileLocation, strResults

    Const forReading = 1

' The file contains on each line:
    ' Text1 (tab) Text2 (tab) Text3 (tab) Text4
    ' Text5 (tab) Text6 (tab) Text7 (tab) Text8
'etc etc


    Set fso = CreateObject("Scripting.FileSystemObject")
        sFileLocation = "file 2.txt"

        Set oFile = fso.OpenTextFile(sFileLocation, forReading, False)

    Do While oFile.AtEndOfStream <> True
        strResults = oFile.ReadAll
    Loop

' Close the file
    oFile.Close

' Release the object from memory
    Set oFile = Nothing

' Return the contents of the file if not Empty
    If Trim(strResults) <> "" Then

        ' Create an Array of the Text File
        arrline = Split(strResults, vbNewLine)
    End If

    For i = 0 To UBound(arrline)
        If arrline(i) = "" Then
            ' checks for a blank line at the end of stream
            Exit For
        End If 

        ReDim Preserve arrMain(i)

            arrMain(i) = Split(arrline(i), vbTab)

    Next

    fso.MoveFile "file 2.txt", arrMain(1)(3) & ".txt"

End Sub ' TwoDimensionArrayTest

提前致谢, 乔

I have written a script that works. What it does now is it looks through a directory to a given file and returns what is on the second row fourth tab (RXC193) and renames the file to that of which it found from a file like this:

@Program @RxBIN @RXPCN @RxGroup @MemberID @WebsiteE @WebsiteS @VerticalLogo @TextLogo
RXCUT 013824 RXCUT RXC193 RXC5FHXF9 www.rxcut.com/HBG www.rxcut.com/HBG/es P:\RxCut\In Design Implementation\RXC193

What I need this script to be able to do is loop through the directory and rename all files by this RXC#####. Here is the script:

Call TwoDimensionArrayTest

Sub TwoDimensionArrayTest
' Version 1.0
' Writtem by Krystian Kara
' Dated 25-Jan-2009


    Dim fso
    Dim oFile
    Dim arrline
    Dim arrItem
    Dim objFolder
    Dim i
    Dim arrMain()
    Dim sFileLocation, strResults

    Const forReading = 1

' The file contains on each line:
    ' Text1 (tab) Text2 (tab) Text3 (tab) Text4
    ' Text5 (tab) Text6 (tab) Text7 (tab) Text8
'etc etc


    Set fso = CreateObject("Scripting.FileSystemObject")
        sFileLocation = "file 2.txt"

        Set oFile = fso.OpenTextFile(sFileLocation, forReading, False)

    Do While oFile.AtEndOfStream <> True
        strResults = oFile.ReadAll
    Loop

' Close the file
    oFile.Close

' Release the object from memory
    Set oFile = Nothing

' Return the contents of the file if not Empty
    If Trim(strResults) <> "" Then

        ' Create an Array of the Text File
        arrline = Split(strResults, vbNewLine)
    End If

    For i = 0 To UBound(arrline)
        If arrline(i) = "" Then
            ' checks for a blank line at the end of stream
            Exit For
        End If 

        ReDim Preserve arrMain(i)

            arrMain(i) = Split(arrline(i), vbTab)

    Next

    fso.MoveFile "file 2.txt", arrMain(1)(3) & ".txt"

End Sub ' TwoDimensionArrayTest

Thanks in advance,
Joe

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

若水微香 2024-09-24 11:42:27

一种方法是在子过程中参数化文件名,以便可以对不同的文件多次调用它,如下所示:

Sub TwoDimensionArrayTest(fileName) 'you may want a more descriptive name

    ' ...
    sFileLocation = fileName
    ' ...

End Sub

然后,编写一个遍历目录的循环,每次都调用子过程:

Dim fso, folder

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("Your Folder Name")
For Each file In folder.Files
    TwoDimensionArrayTest file.Path
Next

One approach is to parameterize the file name in your sub-procedure so it can be called multiple times for different files, like this:

Sub TwoDimensionArrayTest(fileName) 'you may want a more descriptive name

    ' ...
    sFileLocation = fileName
    ' ...

End Sub

Then, write a loop that goes through your directory, calling your sub each time around:

Dim fso, folder

Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("Your Folder Name")
For Each file In folder.Files
    TwoDimensionArrayTest file.Path
Next
我喜欢麦丽素 2024-09-24 11:42:27

这是最终的无错误代码!最后让它搜索我的 Tab-delimited.txt 文件目录并从第二行第三个选项卡(组号)中抓取,然后将文件重命名为其相应的组号!耶!

这是最终的无错误代码!:

Call TwoDimensionArrayTest

Sub TwoDimensionArrayTest

Dim fso
调暗文件
昏暗的路线
调暗 arrItem
昏暗的我
昏暗 arrMain()
Dim sFileLocation, strResults

Const forReading = 1

strFolder = "C:\Documents and Settings\jmituzas.NMCLLC\Desktop\desktop2\新文件夹 (2)\datafiles"
设置 objFSO = CreateObject("Scripting.FileSystemObject")
对于 objFSO.GetFolder(strFolder).Files 中的每个 objFile
If Right(LCase(objFile.Name), 4) = LCase(".txt") then

    ' The file contains on each line:
' Text1 (tab) Text2 (tab) Text3 (tab) Text4
' Text5 (tab) Text6 (tab) Text7 (tab) Text8

'etc etc

Set fso = CreateObject("Scripting.FileSystemObject")
sFileLocation = objFile.Name

    Set oFile = fso.OpenTextFile(objFile.Name, forReading, False)

Do While oFile.AtEndOfStream <> True
    strResults = oFile.ReadAll
Loop

' Close the file
oFile.Close

' 从内存中释放对象
Set oFile = Nothing

' 如果不为空则返回文件内容
如果 Trim(strResults) <> "" 那么

    ' Create an Array of the Text File
    arrline = Split(strResults, vbNewLine)
End If

For i = 0 To UBound(arrline)
    If arrline(i) = "" Then
        ' checks for a blank line at the end of stream
        Exit For
    End If 

    ReDim Preserve arrMain(i)

        arrMain(i) = Split(arrline(i), vbTab)

Next

  fso.MoveFile sFileLocation, arrMain(1)(3) & ".txt"

结束如果
下一个
结束子'二维数组测试

Here is the Final Error free code! Finally have it searching through my directory of Tab-delimited.txt files and grabbing from the second row third tab (group number) then renaming the files to its corrisponding group number! YAY!

heres final error free code!:

Call TwoDimensionArrayTest

Sub TwoDimensionArrayTest

Dim fso
Dim oFile
Dim arrline
Dim arrItem
Dim i
Dim arrMain()
Dim sFileLocation, strResults

Const forReading = 1

strFolder = "C:\Documents and Settings\jmituzas.NMCLLC\Desktop\desktop2\New Folder (2)\datafiles"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If Right(LCase(objFile.Name), 4) = LCase(".txt") Then

    ' The file contains on each line:
' Text1 (tab) Text2 (tab) Text3 (tab) Text4
' Text5 (tab) Text6 (tab) Text7 (tab) Text8

'etc etc

Set fso = CreateObject("Scripting.FileSystemObject")
sFileLocation = objFile.Name

    Set oFile = fso.OpenTextFile(objFile.Name, forReading, False)

Do While oFile.AtEndOfStream <> True
    strResults = oFile.ReadAll
Loop

' Close the file
oFile.Close

' Release the object from memory
Set oFile = Nothing

' Return the contents of the file if not Empty
If Trim(strResults) <> "" Then

    ' Create an Array of the Text File
    arrline = Split(strResults, vbNewLine)
End If

For i = 0 To UBound(arrline)
    If arrline(i) = "" Then
        ' checks for a blank line at the end of stream
        Exit For
    End If 

    ReDim Preserve arrMain(i)

        arrMain(i) = Split(arrline(i), vbTab)

Next

  fso.MoveFile sFileLocation, arrMain(1)(3) & ".txt"

End If
Next
End Sub ' TwoDimensionArrayTest

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文