0

我有一个子程序，它在作为独立宏运行时工作正常，但如果我调用它

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
4

3 回答 3

2

如果您使用 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\")

否则，如果输入参数 forupdateAllWorkbooks是如下代码中的字符串

Sub updateAllWorkbooks(fld As String)


End Sub

然后使用

selectedfolder = fso.GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled     Repository\")
于 2013-05-10T05:18:17.547 回答
1

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

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

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. 中删除。这将出错，因为它是一个字符串，而不是一个对象。SetSet selectedFolderselectedFolder

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

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
于 2013-05-10T14:14:48.130 回答
0

试试这样：

Set selectedfolder = GetFolder("C:\Users\Tim\Desktop\SampleCo 360\360 macro\360 Compiled     Repository\")
于 2013-05-10T03:29:45.657 回答