Question

我正在编写一个过程，该过程需要遍历文件夹中的所有Excel文件并将每个文件另存为管道分隔值。

关于如何执行此操作，我做了很多事情，其中大多数人都说要更改“区域”设置中的定界符值。这不是我的选择，因为这将在客户的系统上实现，并且我无法更改这些设置。

我在每个文件中都有一些代码可以用作vba宏，并且我有一个vbs脚本，该脚本循环遍历文件夹中的文件，并将其转换为制表符分隔的文件，这两个文件均可在此站点找到，适应了我的需要。

这是我到目前为止的代码：

WorkingDir = "C:\Test\Temp"
savedir="C:\Test\Temp\"

Dim fso, myFolder, fileColl, aFile, FileName, SaveName
Dim objExcel, objWorkbook
Dim lastColumn
Dim lastRow
Dim strString
Dim i
Dim j
Dim outputFile
Dim objectSheet
Dim objectCells


Set fso = CreateObject("Scripting.FilesystemObject")
Set myFolder = fso.GetFolder(WorkingDir)
Set fileColl = myFolder.Files

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = False
objExcel.DisplayAlerts = False

For Each aFile In fileColl
    name= Left(aFile.Name,Len(aFile.Name)-Len(Extension))
    Set objWorkbook = objExcel.Workbooks.Open(aFile)
    Set objectSheet = objExcel.ActiveWorkbook.Worksheets(1)
    Set objectCells = objectSheet.Cells
    lastColumn = objectSheet.UsedRange.Column - 1 + objectSheet.UsedRange.Columns.Count
    lastRow = objectSheet.UsedRange.Rows(objectSheet.UsedRange.Rows.Count).Row
    SaveName = savedir & name & ".txt"
    Set outputFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(SaveName, 2, true)
    For i = 1 To lastRow
        objectSheet.Cells(i, 1).Select '<-- this is the line currently causing problems
        strString = ""
        For j = 1 To lastColumn
            If j <> lastColumn Then
                strString = strString & objectCells(i, j).Value & "|"
            Else
                strString = strString & objectCells(i, j).Value
            End If
        Next
        outputFile.WriteLine(strString)
    Next

    objFileToWrite.Close
    Set objFileToWrite = Nothing
Next

Set objWorkbook = Nothing
Set objExcel = Nothing
Set myFolder = Nothing
Set fileColl = Nothing
Set fso = Nothing

我实际上并不经常使用vb，因此我基本上是在更改一行，直到它不再引发错误，然后再继续下一行。

我只是无法通过注释行得到这个。当前它给我的错误代码为“范围类的选择方法失败”，代码为800A03EC。搜索这个并没有给我带来任何实际结果...

由于文件包含许多常见的定界符（逗号，制表符等），因此几乎必须对文件进行管道定界。

我们非常感谢您提供帮助以使其正常工作。这是我在这里的第一篇文章，如果给我太多或太少的信息，我们深表歉意，请告诉我，我会根据需要进行更新

更新设法使其正常工作，我的工作代码在下面的答案中。如果有人对如何更快地提出建议，将不胜感激：）

Answer 1

我设法破解了它，我必须先激活想要的工作表，然后才能使用它，而且还要按名称调用工作表而不是使用“ 1”。下面的工作代码以防将来对其他人有帮助。我知道这很丑陋，可能可以做得更好，但效果很好：）

WorkingDir = "C:\Test\Temp"
savedir="C:\Test\Temp\"      
Extension = ".xls"

neededextension= ".txt"
Dim fso, myFolder, fileColl, aFile, FileName, SaveName
Dim objExcel, objWorkbook
Dim lastColumn
Dim lastRow
Dim strString
Dim i
Dim j
Dim outputFile
Dim objectSheet
Dim objectCells


Set fso = CreateObject("Scripting.FilesystemObject")
Set myFolder = fso.GetFolder(WorkingDir)
Set fileColl = myFolder.Files

Set objExcel = CreateObject("Excel.Application")
objExcel.EnableEvents = false

objExcel.Visible = False
objExcel.DisplayAlerts = False

For Each aFile In fileColl
    ext = Right(aFile.Name,Len(Extension))
    name= Left(aFile.Name,Len(aFile.Name)-Len(Extension))
    Set objWorkbook = objExcel.Workbooks.Open(aFile)
    Set objectSheet = objExcel.ActiveWorkbook.Worksheets("MICE BOB")
    Set objectCells = objectSheet.Cells
    lastColumn = objectSheet.UsedRange.Column - 1 + objectSheet.UsedRange.Columns.Count
    lastRow = objectSheet.UsedRange.Rows(objectSheet.UsedRange.Rows.Count).Row
    SaveName = savedir & name & ".txt"
    Set outputFile = CreateObject("Scripting.FileSystemObject").OpenTextFile(SaveName, 2, true)
    For i = 1 To lastRow
        objectSheet.Activate
        objectSheet.Cells(i, 1).Select
        strString = ""
        For j = 1 To lastColumn
            If j <> lastColumn Then
                strString = strString & objectCells(i, j).Value & "|" ' Use ^ instead of pipe.
            Else
                strString = strString & objectCells(i, j).Value
            End If
        Next
        outputFile.WriteLine(strString)
    Next

    objFileToWrite.Close
    Set objFileToWrite = Nothing
Next

Set objWorkbook = Nothing
Set objExcel = Nothing
Set myFolder = Nothing
Set fileColl = Nothing
Set fso = Nothing

我现在唯一的问题是转换需要很长时间。有人对如何加快速度有建议吗，还是这种性质只是意味着它会变慢？

如何将文件夹中的所有Excel文件另存为管道分隔文件

1 个答案: