Question

我有一个sub作为一个独立的宏运行时工作正常，但如果我称之为

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

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

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的输入参数是下面代码中的文件夹

Sub updateAllWorkbooks(fld As Folder)

End Sub

然后使用

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

否则，如果updateAllWorkbooks的输入参数是一个字符串，如下面的代码

Sub updateAllWorkbooks(fld As String)


End Sub

然后使用

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

Answer 2

看起来你只是在使用字符串路径。为此，我不确定为什么要使用FileSystemObject的GetFolder方法。

相反，您可以使用字符串，例如：

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 这对我有用（暂不测试updateAllWorkbooks。从Set删除Set selectedFolder。这会出错，因为{{1}是一个字符串，而不是一个对象。

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

FileSystemObject

Answer 3

试试这样：

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

调用sub不能像运行宏一样工作

3 个答案: