1

我正在尝试更改以下代码，该代码从活动工作簿中复制 sheet1 并使用名为 CreateFolder 的函数将其保存到文件夹中，一切正常。

从这里：调整代码以将 excel 文件的 sheet1 复制到 sheet1 新的 excel 文件

我试图更改它以复制整个工作簿以发送到由 CreateFolder 创建的文件夹。

谢谢

编辑：更新的代码

Sub CopySheets()

Dim SourceWB As Workbook
Dim filePath As String

'Turns off screenupdating and events:
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'path refers to your LimeSurvey workbook
Set SourceWB = ActiveWorkbook

filePath = CreateFolder

SourceWB.SaveAs filePath
SourceWB.Close
Set SourceWB = Nothing

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Function CreateFolder() As String

Dim fso As Object, MyFolder As String
Set fso = CreateObject("Scripting.FileSystemObject")

MyFolder = ThisWorkbook.Path & "\360 Compiled Repository"


If fso.FolderExists(MyFolder) = False Then
    fso.CreateFolder (MyFolder)
End If

MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY")

If fso.FolderExists(MyFolder) = False Then
    fso.CreateFolder (MyFolder)
End If

CreateFolder = MyFolder & "\360 Compiled Repository" & " " & Range("CO3") & " " & Format(Now(), "DD-MM-YY hh.mm") & ".xls"
Set fso = Nothing

End Function
4

1 回答 1

1

要复制整个工作簿，您可以使用以下代码

Sub CopySheets()


    Dim SourceWB As Workbook
    Dim filePath As String

    'Turns off screenupdating and events:
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False


    'path refers to your LimeSurvey workbook
    Set SourceWB = Workbooks.Open(ThisWorkbook.Path & "\LimeSurvey.xls")

    filePath = CreateFolder

    SourceWB.SaveAs filePath
    SourceWB.Close
    Set SourceWB = Nothing

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub
Function CreateFolder() As String

    Dim fso As Object, MyFolder As String
    Set fso = CreateObject("Scripting.FileSystemObject")

    MyFolder = ThisWorkbook.path & "\Reports"


    If fso.FolderExists(MyFolder) = False Then
        fso.CreateFolder (MyFolder)
    End If

    MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY")

    If fso.FolderExists(MyFolder) = False Then
        fso.CreateFolder (MyFolder)
    End If

    CreateFolder = MyFolder & "\Data " & Format(Now(), "DD-MM-YY hh.mm.ss") & ".xls"
    Set fso = Nothing

End Function
于 2013-05-05T16:26:01.083 回答