Открыть все файлы в папке (Разные типы: VBA, excel, word)
Я пытаюсь сделать код VBA, который перебирает все файлы в моей папке. В папке есть разные файлы, в том числе .vbs, .doc, .pdt и т. д. У меня есть код, который открывает все в книге, но не работает, чтобы открыть их в правильном формате. Я пробовал разные функции оболочки, но это тоже не сработало.
Sub Looping()
'Step 1:Declare your variables
Dim MyFiles As String
'Step 2: Specify a target folder/directory, you may change it.
MyFiles = Dir("C:\Users\path of folder\")
Do While MyFiles <> ""
'Step 3: Open Workbooks one by one
Workbooks.Open "C:\Users\path of folder\" & MyFiles
ActiveWorkbook.Activate
'run some code here
Application.Wait (Now + TimeValue("0:00:10"))
ActiveWorkbook.Close SaveChanges:=True
'Step 4: Next File in the folder/Directory
MyFiles = Dir
Loop
End Sub
Любая помощь будет оценена
Вы пытаетесь/хотите открыть их в Excel?
@BigBen Я просто хочу отображать их в течение установленного времени (сейчас 10 секунд), а затем закрыть элемент и перейти к следующему. Практически создание слайд-шоу из разных файлов.
@FaneDuru Нет, я хочу открыть их, поскольку исходный документ IE Word открывается для файла .doc
Я могу показать вам, как открыть каждый такой файл в приложении по умолчанию, но закрытие их по истечении определенного периода времени выглядит сложным. Я имею в виду способ, но не так просто реализовать его для всех возможных файлов...
@FaneDuru, пока мне не нужно объявлять имя документа, я согласен увидеть ваш вариант.
@ Тара, то, что ты пытаешься сделать, звучит круто. По какой причине вы хотите иметь такое слайд-шоу? Что такое бизнес-кейс?
@zedfoxus Да, у нас есть телевизоры на производстве, и я хочу, чтобы телевизор циклически просматривал различные документы / PDF-файлы / и т. д., Которые имеют отношение к этой области.
ХОРОШО. подготовлю ответ...
Пожалуйста, протестируйте код ответа и отправьте отзыв.
Ответы 1
Пожалуйста, попробуйте следующий обновленный саб. Он будет использовать известные приложения для книг или документов Word, чтобы открывать/закрывать их и FollowHyperlink открывать остальные расширения в их приложении по умолчанию, затем находить их процесс приложения и завершать его.
Отредактировано: Чтобы избежать этого знака ожидания, я изменил Application.Wait (Now + TimeValue("0:00:10")) на Sleep API. Пожалуйста, сначала скопируйте следующую функцию API поверх модуля, сохранив код (в области объявлений):\
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
Затем следующий обновленный код в том же модуле:
Sub Looping()
Dim MyFiles As String, folderPath As String, strExt As String, wb As Workbook
folderPath = ThisWorkbook.Path & "\TestCSV\"
MyFiles = Dir(folderPath & "*.*")
Do While MyFiles <> ""
strExt = Split(MyFiles, ".")(1)
Select Case LCase(strExt)
Case "xls", "xlsx", "xlsm", "xlsb", "csv"
Set wb = Application.Workbooks.Open(folderPath & MyFiles)
Case "doc", "docx", "docm"
Dim appWord As Word.Application, doc As Object
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
Set doc = appWord.Documents.Open(folderPath & MyFiles)
Case "vbs"
Dim cmdStr As String, strVBSPath As String
strVBSPath = folderPath & MyFiles
cmdStr = "cmd.exe /c """ & strVBSPath & """"
Shell cmdStr, 0
Case Else
ActiveWorkbook.FollowHyperlink folderPath & MyFiles
End Select
DoEvents
Sleep 5000 'for 5 seconds, 10000 for 10 seconds
'Application.Wait (Now + TimeValue("0:00:5"))
DoEvents
Select Case LCase(strExt)
Case "xls", "xlsx", "xlsm", "xlsb", "csv"
wb.Close False
Case "doc", "docx", "docm"
doc.Close: appWord.Quit
Case "vbs": 'do nothing in such a case...
Case Else
Dim exeApp As String
exeApp = GetApplication("." & strExt)
TerminateProcess exeApp 'it terminates the whole process.
'for a pdf file, even if some more files were open in Acrobat
'all files will also be closed when process is terminated...
End Select
MyFiles = Dir 'continue the loop
Loop
End Sub
Другие необходимые функции:
Private Function GetApplication(ext As String) As String
Dim strAppl As String, strPathExe As String, strExeFile As String, strODSfile As String
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")
On Error Resume Next
strAppl = WSHShell.RegRead("HKEY_CLASSES_ROOT\" & WSHShell.RegRead("HKEY_CLASSES_ROOT\" & ext & "\") & _
"\shell\open\command\")
If err.Number <> 0 Then
err.Clear: On Error GoTo 0
GetApplication = ""
MsgBox "No program installed for extension """ & ext & """"
Exit Function
End If
On Error GoTo 0
strExeFile = Split(strAppl, """ """)(0)
strExeFile = Right(strExeFile, Len(strExeFile) - 1)
strExeFile = Right(strExeFile, Len(strExeFile) - InStrRev(strExeFile, "\"))
GetApplication = strExeFile
End Function
Private Sub TerminateProcess(sExeName As String)
Dim strComputer As String, objWMIService As Object, colItems As Object, objItem As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = '" & sExeName & "'", , 48)
For Each objItem In colItems
objItem.Terminate
Next
End Sub
Также существуют расширения (например, .txt), для которых процесс не может быть возвращен вышеопробованным способом. Я думаю, что я также могу найти способ определить обработчик окна приложения (на основе его заголовка, содержащего имя файла), а затем извлечь процесс из обработчика окна. Но это сложно и если не использовать текстовые файлы, будет много бесполезной работы...
Код не тестировался, но должен работать. Если проблема, я, вероятно, упустил что-то незначительное, опечатки и т. д. В таком случае не стесняйтесь обращаться за разъяснениями, упоминая ошибку или любое другое неудобство, которое у вас есть.
Я переместил оператор select после цикла и теперь работает отлично!
единственная проблема заключается в том, что vbs имеет предупреждающее сообщение. есть ли способ обойти это в коде?
@Tara Это невозможно ... Если вы переместите оператор Select за пределы цикла, он обработает только последний файл, найденный в этой папке. Я не уверен, что смогу тебя понять... Говорить "предупреждающее сообщение" совсем не красноречиво. Какое предупреждающее сообщение вы получаете и для какого типа файла? Теоретически это может произойти, если вы попытаетесь открыть файл, который может нанести вред вашему компьютеру (файл .bat, vbs и т. д.).
@Tara Я обновил код примерно за час до этого. Я пытался избежать знака ожидания во время Wait. Код теперь использует Sleep API. Я также исправил некоторые части кода. Пожалуйста, попробуйте, но как есть... Теперь я должен закрыть свой ноутбук. Если что-то не так, пожалуйста, уточните, что происходит, и я отвечу завтра.
* Обновление просто изменило его, и он отлично работает. Ошибка, которую я получаю, возникает, когда я запускаю файл VBS, и он говорит, что это может нанести вред моему компьютеру. Я должен нажать «ОК», чтобы принять его для запуска. Есть ли способ не нажимать ОК?
Код работает отлично, но сейчас я пытаюсь сделать код vbs для автоматизации макроса, однако он не работает. У вас есть код, который заставит это работать?
@ Тара, я пропустил твой вчерашний комментарий. Я понял, что вам нужно показать что-то из разных файлов... Если вы хотите запустить скрипт vbs, я могу адаптировать код для этого. В соответствии с вашими настройками UAC потребуется разрешение или нет. Я не уверен, что правильно понял последний вопрос. Вам нужен код VBS для запуска вышеуказанного кода? Если да, хотите ли вы, чтобы он открыл книгу, запустил подпрограмму и закрыл ее? Что именно из того, что я упомянул (или что-то еще), вам действительно нужно?
@Tara На данный момент адаптировал код для запуска VBScript. Если он запрашивает разрешения, попробуйте добавить папку, которую вы итерируете, в доверенные расположения Excel (Параметры - Центр управления безопасностью - Настройки центра управления безопасностью... - Надежные расположения: добавьте новые расположения, перейдите к папке и нажмите ОК, ОК, ОК) .
Я предполагаю, что TESTCVS должен быть путем к файлу, например C:\.... однако, когда я добавляю свой путь к файлу, я получаю, что MyFiles - это неправильное имя файла. Я делаю что-то неправильно?
@ Тара, я до сих пор ничего не понимаю ... Что должно означать «когда я добавляю свой путь к файлу»? Где вы пытаетесь добавить путь в обсуждение? Должно ли это быть частью кода VBScript для автоматизации запуска вышеуказанного Sub?
У меня все заработало, теперь моя проблема в том, что все файлы открываются на панели значков, но не отображаются на экране. Я пытаюсь добавить дисплей, чтобы он всегда находился перед монитором.
@ Тара Этого не должно быть. Все запущенные приложения должны быть в фокусе. Когда вы «заставили это работать», вы изменили код? Если да, то не могли бы вы сказать мне, что вы изменили? Если нет и это не конфиденциально, можете ли вы поделиться рабочей книгой, которую используете? Помимо всего этого, не могли бы вы уточнить мои предыдущие вопросы, касающиеся «кода vbs для автоматизации макроса», «добавление пути к файлу»?
MyFiles = Dir(folderPath & ".") имеет неверное имя или номер файла
Если вы использовали его так, как показываете, это неправильно. Должно быть Dir(folderPath & "*.*"), но я думаю, что здесь просто опечатка. Эта ошибка не требует пояснений: указанный вами путь (folderPath) неверен. Он не заканчивается на "\", или просто не существует...
извините, я пока не могу отправлять чаты через это. Код работает отлично, но есть задержки при открытии каждого файла. Я добавил Application.Wait(Now + TimeValue("0:00:01")), но это, похоже, не помогает быстрее открывать файлы. Есть ли у вас какие-либо идеи?
@Tara Открытие файла не имеет ничего общего со временем ожидания для его отображения. Боюсь, я не понимаю, что вы имеете в виду. Во всяком случае, меня не устраивает ваш способ ответа. Должно быть очевидно объяснить при каких обстоятельствах повышение кода Bad file name or number, и через некоторое время это не так... Я не могу слишком много понять из полученных от вас отзывов.
Привет @FaneDuru, я упомянул, что код работает. Я принял исправления, которые вы упомянули, и они работают. Я не знаю, как моего отзыва недостаточно. Можете ли вы уточнить? Я просто сейчас пытаюсь заставить макрос работать быстрее, то есть у меня нет задержки при открытии всех элементов в папке.
@Tara Вы сказали, что код работает, прежде чем упомянуть проблему «Неверное имя или номер файла» ... Я не упомянул ни одного исправления, так как не видел код, который вы используете. Я сделал несколько предположений, и вы должны подтвердить, было ли одно из них причиной. Тогда я вам сказал, что открытие само по себе не имеет ничего общего с программной задержкой. Я попытался заменить Application.Wait, предложив вариант, не показывающий знак ожидания и допускающий установку миллисекунд. Вы ничего не можете сделать с самим открытием. Если общее время между двумя последовательными запусками приложений проблематично, вы можете поиграть с Sleep.
Что вы собираетесь делать с этими файлами, когда откроете их?