Шеф дал задание составить список файлов: актов, счет-фактур. А их ТЫСЯЧИ!!!

[ru3000]

Мне так и не удалось победить запуск сотен процессов WINWORD.exe при сканировании макросом папки. Приходится сканировать частями и пока комп окончательно не повисает сохранять полученное и перезагружаться уже с кнопки. Может быть есть возможность усовершенствования кода? А то геморроя с документами у меня впереди еще много.

[EducatedFool]

Попробуйте использовать такой вариант функции GetInfoWD

Function GetInfoWD(ByVal filename As String, ByRef res1, ByRef res2)
    On Error Resume Next
    Set wa = CreateObject("Word.Application")
    Set doc = wa.Documents.Open(filename, , True)
    txt1 = "одной стороны, и ": txt2 = "(далее по тексту": txt = doc.Range.Text
    res1 = Mid(txt, InStr(1, txt, txt1) + Len(txt1))
    res1 = Trim(Left(res1, InStr(1, res1, txt2) - 1))
    res2 = doc.Tables(2).Rows(doc.Tables(2).Rows.Count - 1).Cells(doc.Tables(2).Columns.Count).Range.Text
    res2 = Val(Replace(Replace(res2, Chr(13) & Chr(7), ""), ",", "."))
    doc.Close False
    wa.Quit False
    Set doc = Nothing: Set wa = Nothing
End Function

Должно помочь...

[ru3000]

Спасибо, огромное. Действительно помогло.

[ru3000]

Столкнулся с проблемой. В некоторых счетах вместо Всего к оплате написано Всего по счету. Как исправить в текущем коде, чтобы res2 принимало значение либо Всего к оплате, либо Всего по счету. Спасибо.

        Case filename Like "Счет*":
            v = "Счет"
            n = Trim(Mid(Split(filename, " ")(1), 2))
            res1 = "Заказчик:": res2 = "Всего к оплате"
            GetInfoXL filenameL, res1, res2, , 2, , 2

[EducatedFool]

чтобы res2 принимало значение либо Всего к оплате, либо Всего по счету

        Case filename Like "Счет *":
            v = "Счёт"
            n = Trim(Mid(Split(filename, " ")(1), 2))
            res1 = "Заказчик:": res2 = "Всего к оплате"
            GetInfoXL filenameL, res1, res2, , 2, , 2
            If res2 = "Всего к оплате" Then
                res1 = "Заказчик:": res2 = "Всего по счету"
                GetInfoXL filenameL, res1, res2, , 2, , 2
            End If

Спасибо

Это была последняя доработка "за спасибо". Все дальнейшие доработки с моей стороны - за WebMoney.
Ну или самостоятельно разбирайтесь в коде - там нет ничего сложного.

[ru3000]

Премного благодарен.

[golex]

Доброго времени суток, помогите "плиз" довести до ума, в VBA соображаю методом научного тыка. Суть:

Select Case True
Case filename Like "с*":
res1 = "СЧЕТ": res2 = "Плательщик": res3 = "*S-36*"
GetInfoXL filenameL, res1, res2, res3, , , 1, , , 3
Case Else
End Select
cell.Next.Resize(, 3).Value = Array(res1, res2, res3)

нужно из "res2" извлекать заключенное в " " , пример ООО филиал "Рога и копыта 2", по res3, может повторяться, нужно отобразить их сумму.
Заранее спс

[diment]

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

EducatedFool SUPER!!!

[golex]

согласен с Вами "diment", подход чрезвычайно рационализаторский, догадывался что такое возможно, наконец увидел во плоти создание от EducatedFool, человек реально в теме

[EducatedFool]

нужно из "res2" извлекать заключенное в " " , пример ООО филиал "Рога и копыта 2", по res3, может повторяться, нужно отобразить их сумму

Не совсем понятно задание.

Нужна функция обработки строки, которая из текста ООО филиал "Рога и копыта 2" вырежет всё лишнее, оставив только Рога и копыта 2?

Какую сумму надо отобразить?
Сумму букв в слове, или сумму рогов и копыт?