#vba #excel
#vba #excel
Вопрос:
Я написал следующий код, который должен открыть указанный каталог Windows, а затем один за другим обработать все файлы Excel (.xls) в этом месте. Чтобы быть более конкретным, код откроет файл Excel, возьмет имя, указанное на листе, и поместит это имя / значение в ячейку A1 этого листа, а затем сохранит и закроет файл. Затем он перейдет к следующему файлу Excel в каталоге.
Проблема, с которой я сталкиваюсь, заключается в том, что при выполнении кода я получаю следующую ошибку компиляции: «Sub или функция не определены». Я просто не могу понять, что вызывает эту ошибку.
Пожалуйста, ознакомьтесь с приведенным ниже кодом:
Sub UseSheetName()
selectedfolder = GetFolder("c:")
Call updateAllWorkbooks(selectedfolder)
End Sub
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Function updateAllWorkbooks(workDir)
Dim fso, f, fc, fl
Dim newName As String, appStr As String, SubDir As String
On Error GoTo updateAllWorkbooks_Error
SubDir = workDir amp; "" amp; "ConvertedFiles"
If Not fExists(SubDir) Then
MkDir SubDir
End If
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(workDir)
Set fc = f.Files
For Each fl In fc
If Right(fl, 4) = ".xls" Then
Application.DisplayAlerts = False
Workbooks.Open Filename:=fl
ActiveSheet.[a1] = ActiveSheet.Name
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
Next
Application.ScreenUpdating = True
On Error GoTo 0
Exit Function
updateAllWorkbooks_Error:
MsgBox "Error " amp; Err.Number amp; " (" amp; Err.Description amp; ") in procedure updateAllWorkbooks of Module Module2"
End Function
Комментарии:
1. При компиляции с такой ошибкой подсвечивается код-нарушитель. Итак, глядя на ваш экран, вы должны дать вам ответ. И в любом случае, вы должны указать в своем вопросе, где происходит ошибка.
2. Он выделяет его в редакторе. fExists — это не команда.
3. Usethe FileSystemObject возвращает True, если указанная папка существует; False, если она не существует.
object.FolderExists(folderspec)4. здравствуйте, прошло много времени с тех пор, как я просматривал код vb / vba. одна вещь, которая МОЖЕТ помочь, — добавить option explicit в верхней части модуля кода. это означает, что любые переменные, которые не определены (и / или функции, которые не существуют), записываются в редакторе
Ответ №1:
Если это весь ваш код, то у вас нет функции, определенной как fExists . Таким образом, в строке произойдет сбой If Not fExists(SubDir) Then , поскольку функция fExists не определена.
Комментарии:
1. Привет, спасибо всем за быстрый ответ. Как указано, функция FExists отсутствовала. Я обновил приведенный выше код, включив в него функцию follwing, и теперь он работает нормально. Еще раз большое спасибо за вашу помощь. С уважением,
2. пользователь378.. — вы должны дать этому ответу оценку плюс отметить его как правильный ответ для будущих посетителей
3. Джим, ты прав. Поэтому в мой исходный код были добавлены следующие строки, чтобы он работал. Как указано, была добавлена функция fExist. Функция fExists(новое имя в виде строки) как логическое значение dim тестер как целое число при возобновлении ошибки Следующий тестер = GetAttr(новое имя) Выберите регистр err.Числовой регистр = 0 fExists = True Регистр Else fExists = False Конечный выбор при ошибке GoTo 0 Конечная функция
4. Нет смысла указывать Error <anything> в качестве последнего оператора в функции. Он сбрасывается на настройку родительской функции в End Sub / Function.
5. Поскольку данный ответ решил ваш первоначальный вопрос, пожалуйста, проголосуйте и отметьте как ответ.