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\")

else の入力パラメータupdateAllWorkbooksが以下のコードのような文字列の場合

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

単に文字列パスを操作しているようです。GetFolderそのために、なぜFileSystemObjectのメソッドを使用しているのかわかりません。

代わりに、次のように文字列を使用できます。

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ため、これはエラーになります。selectedFolder

また、このサブルーチンでは a は必要ありませ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
于 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 に答える