首页 > 解决方案 > 如何自动打开文本文件:查找、复制数据和粘贴

问题描述

因此,我正在尝试自动化一项任务,该任务涉及打开一个包含相似的 .ist 文档的整个文件夹并粘贴数据。我已经有允许我单击每个项目的代码,但我正试图使这项任务完全自动化。我对此很陌生。我有使用 C 编码的经验,但我只编写了一周的 vba 编码。

所以这就是我所拥有的:

这是有效的代码

Sub Figureitout()

    Dim fileName As Variant, text(1 To 890) As String, textline As String
    Dim num As Integer
    Dim strDir As String, fso As Object, objFiles As Object, obj As Object, fileCount As Integer
    Dim myFile As Variant
    Dim posTorque As Integer, posOffset As Integer

        'specify folder path
        strDir = "C:\Users\Desktop\Folder\"

        'create filesystemobj
        Set fso = CreateObject("Scripting.FileSystemObject")

        'get the folder
        Set objFiles = fso.GetFolder(strDir).Files

        'count all the files
        fileCount = objFiles.Count

        'Total number of files in folder
        MsgBox fileCount

        'read file name
        'fileName = Dir(strDir)
        'MsgBox fileName

        'counter intitialize
        num = 1

        Do Until num = fileCount

            'choose file
            myFile = Application.GetOpenFilename("Text Files(*.IST),*.ist", , , , False)

                'open file
                Open myFile For Input As #num

                    'copy file contents
                    Do Until EOF(num)
                        Line Input #(num), textline
                        text(num) = text(num) & textline

                    Loop

                    'find data
                    posTorque = InStr(text(num), "Torque:")
                    posOffset = InStr(text(num), "Offset:")

                    'close file
                    Close #num

                'make sure offset value exists in document
                If InStr(text(num), "Offset:") <> 0 Then

                    'paste data
                    Range("A" & num).Value = Mid(text(num), posTorque + 12, 4)
                    Range("B" & num).Value = Mid(text(num), posOffset + 13, 4)

                End If

                'delete chosen file
                Kill (myFile)

            'increment prior to loop
            num = num + 1

            'Reset data
            posTorque = 0
            posOffset = 0

        Loop

End Sub

所以我正在考虑有这样的东西:

For Each fileName in fileCount
   FileName = "Dir(strDir)"
   Open fileName for Input As #num 

但我不断收到类型不匹配错误。我假设这是因为 fileName 在这种情况下是一个字符串?

提示?诡计?建议?

标签: excelvba

解决方案


无需将所有文件的完整文本存储在一个数组中,只需在阅读时检查每一行。

Sub ProcessFiles()

    Const FOLDER = "C:\Users\Desktop\Folder\"

    Dim ws As Worksheet
    Dim sFilename As String, textline As String
    Dim i As Integer, ff As Integer, p As Integer, count As Long

    sFilename = Dir(FOLDER & "*.ist") ' first file

    Set ws = ActiveSheet
    i = 0
    Do While Len(sFilename) > 0
        ff = FreeFile
        i = i + 1

        Open FOLDER & sFilename For Input As #ff

        Do Until EOF(ff)
            Line Input #ff, textline

            p = InStr(textline, "Torque:")
            If p > 0 Then
                ws.Range("A" & i).Value = Mid(textline, p + 12, 4)
            End If

            p = InStr(textline, "Offset:")
            If p > 0 Then
                Range("B" & i).Value = Mid(textline, p + 13, 4)
            End If
        Loop
        Close ff

        sFilename = Dir ' get next
        count = count + 1
    Loop

    MsgBox count & " files proccessed in " & FOLDER, vbInformation

End Sub

推荐阅读