调用sub不能像自己运行macros一样工作

我有一个作为一个独立的macros运行良好的子，但如果我打电话给它

Call selectFolderUpdateData

它不会强制这个部分

selectedfolder = GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\")

它直接去

Call updateAllWorkbooks(selectedfolder)

 Sub selectFolderUpdateData() selectedfolder = GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\") Call updateAllWorkbooks(selectedfolder) End Sub 

谢谢

Edit

这是整个事情

 Sub selectFolderUpdateData() Dim fso As Object Dim selectedFolder$ Set fso = CreateObject("Scripting.FileSystemObject") Set selectedFolder = GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\") 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 & "\" & "ConvertedFiles" SubDir = WorkDir 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, 5) = ".xlsx" Then newName = Replace(fl, "xlsx", "xls") newName = Replace(newName, WorkDir, SubDir) If fExists(newName) Then appStr = Format(Now, "hhmmss") & ".xls" newName = Replace(newName, ".xls", appStr) End If Application.DisplayAlerts = False Workbooks.Open fileName:=fl ActiveWorkbook.SaveAs fileName:=newName, FileFormat:=xlExcel8, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False ActiveWorkbook.Save ActiveWorkbook.Close Application.DisplayAlerts = True End If Next Application.ScreenUpdating = True On Error GoTo 0 Exit Function updateAllWorkbooks_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure updateAllWorkbooks of Module Module2" End Function Function fExists(newName As String) As Boolean Dim tester As Integer On Error Resume Next tester = GetAttr(newName) Select Case Err.Number Case Is = 0 fExists = True Case Else fExists = False End Select On Error GoTo 0 End Function 

然后使用以下来呼叫

 Sub run() Call CopySheets Call selectFolderUpdateData Call Deletexlxs End Sub 

Answer 1

看起来你只是在处理stringpath。 为此，我不知道你为什么使用FileSystemObject的GetFolder方法。

相反，你可以使用string，如：

 Sub selectFolderUpdateData() Dim selectedFolder$ selectedfolder ="C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\" Call TestToSeeIfThisWorks(selectedFolder) Call updateAllWorkbooks(selectedfolder) End Sub Sub TestToSeeIfThisWorks(WorkDir as String) msgBox workDir End Sub 

修改＃1这是为我工作（尚未testingupdateAllWorkbooks 。从Set selectedFolder删除Set 。这将是错误，因为selectedFolder是一个string，而不是一个对象。

此外，您不需要在此子例程中使用FileSystemObject （因为您不使用它）。

 Sub selectFolderUpdateData() Dim selectedFolder$ selectedFolder = GetFolder("C:\Users\david_zemens\desktop\") '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 

Answer 2

如果您使用FileSystemObject，则需要先创build它的对象。您的过程如下所示。

 Sub selectFolderUpdateData() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Set selectedfolder = fso.GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\") Call updateAllWorkbooks(selectedfolder) End Sub 

如果updateAllWorkbooks的input参数是像下面的代码一样的文件夹

 Sub updateAllWorkbooks(fld As Folder) End Sub 

然后使用

 Set selectedfolder = fso.GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\") 

否则，如果updateAllWorkbooksinput参数是一个像下面的代码中的string

 Sub updateAllWorkbooks(fld As String) End Sub 

然后使用

 selectedfolder = fso.GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\") 

Answer 3

试试像这样：

 Set selectedfolder = GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled Repository\")