EXCEL2000 VBA XLSTARTフォルダとExcel.libを世代間バックアップする実験

EXCEL2000 VBA  XLSTARTフォルダとExcel.libを世代間バックアップする実験

Sub xlStartフォルダをバックアップ()

'

'xlStartフォルダFULLパス

'C:\Documents and Settings\nokie\Application Data\Microsoft\Excel

'Excelフォルダを世代間バックアップ（XLSTARTフォルダ＋Excel.lib)

'

 

Dim ExcelDir As String      'Excelフォルダパス

Dim SaveDir As String       '保存先フォルダパス

Dim FSO As Object           'FileSystemObject

Dim newDirname As String    '新しい保存フォルダ

 

 

    'ExcelフォルダFULLパス

        ExcelDir = "C:\Documents and Settings\nokie\Application Data\Microsoft\Excel"

    '保存先フォルダパス

        newDirname = Left(Now, 10)   '2012/10/26 17:56:01 → 2012/10/26

        ' / を消す

        newDirname = Replace(newDirname, "/", "")    '/をnullに

        SaveDir = "D:\nokie_BK\office\Excel\" & newDirname  '年月日フォルダ

    'Excelフォルダをコピー

        Set FSO = CreateObject("Scripting.FileSystemObject")

                FSO.CopyFolder ExcelDir, SaveDir

        Set FSO = Nothing

 

End Sub

 

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

一応完成

 

Sub xlStartフォルダをバックアップ()

'

'xlStartフォルダFULLパス

'C:\Documents and Settings\nokie\Application Data\Microsoft\Excel

'Excelフォルダを世代間バックアップ（XLSTARTフォルダ＋Excel.lib)

'

 

Dim ExcelDir As String      'Excelフォルダパス

Dim SaveDir As String       '保存先フォルダパス

Dim FSO As Object           'FileSystemObject

Dim newDirname As String    '新しい保存フォルダ

 

 

    'ExcelフォルダFULLパス

        ExcelDir = "C:\Documents and Settings\nokie\Application Data\Microsoft\Excel"

    '保存先フォルダパス

        newDirname = Left(Now, 10)   '2012/10/26 17:56:01 → 2012/10/26

        ' / を消す

        newDirname = Replace(newDirname, "/", "")    '/をnullに

        SaveDir = "D:\nokie_BK\office\Excel\" & newDirname  '年月日フォルダ

    'Excelフォルダをコピー

        Set FSO = CreateObject("Scripting.FileSystemObject")

                FSO.CopyFolder ExcelDir, SaveDir

        Set FSO = Nothing

    'メッセージ

        MsgBox "完了しました"

    '保存フォルダを開く

        Call Shell("""C:\WINDOWS\EXPLORER.EXE"" ""D:\nokie_BK\office\Excel""")

End Sub

 

タグ：Excel2000 VBA