Как сохранить все файлы Excel в папке как файлы с разделителями трубы - PullRequest
0 голосов
/ 08 апреля 2019

Я пишу процесс, который должен циклически проходить по всем файлам 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, поэтому я в основном меняю строку, пока она не перестанет выдавать ошибки, а затем перейти к следующей.

Я просто не могу получить этонад закомментированной строкой.В настоящее время он дает мне ошибку «Ошибка выбора метода класса Range» с кодом 800A03EC.Поиск этого не дал мне никаких реальных результатов ...

Файл в значительной степени должен быть разделен конвейером, поскольку файл содержит много общих разделителей (запятые, табуляции и т. Д.).

Любая помощь, чтобы заставить это работать, очень ценится.Это мой первый пост, поэтому извиняюсь, если я дал слишком много или слишком мало информации, просто дайте мне знать, и я обновлю по мере необходимости

Обновление Мне удалось заставить его работатьМой рабочий код в ответе ниже.Если у кого-то есть предложения, как сделать это быстрее, это будет оценено :)

1 Ответ

0 голосов
/ 09 апреля 2019

Мне удалось взломать его, мне пришлось активировать лист, который я хотел, прежде чем я смог использовать его, а также вызвать лист по имени вместо использования «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

Единственная проблема, с которой я столкнулся сейчас, заключается в том, что преобразование занимает очень много времени. У кого-нибудь есть предложения о том, как ускорить это, или природа этого просто означает, что он будет медленным?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...