あした

Sub Doc_Move()
                                
    Dim fso                 As Object
    Dim sData_Folder        As String
    Dim sDoc_Folder         As String
    Dim sFname              As String

    Dim sLastUpDay          As String           '最終更新日付
    Dim sLastyyyy           As String           '最終更新年
    Dim sFolyyyy            As String           '年フォルダー

    Set fso = CreateObject("Scripting.FileSystemObject")

    sData_Folder = "\\Server\共有フォルダ\データ\"                  'InFlder
    sDoc_Folder = "\\Server\共有フォルダ\バックアップ\"             'outFolder
    sFname = Dir(sData_Folder & "DOCDOC*.pdf")                      'file name

    Do While sFname <> ""
	'最終更新日付
        sLastUpDay = Replace(Left(fso.GetFile(sData_Folder & sFname).DateLastModified, 10), "/", "")

	'年を取得        
        sLastyyyy = Left(sLastUpDay, 4)
        sFolyyyy = sDoc_Folder & sLastyyyy & "\"
        
	'年フォルダが無かったら作る
        If fso.FolderExists(sFolyyyy) = False Then                                                          
            MkDir sFolyyyy
        End If
        
	'移動
        Name sData_Folder & sFname As sFolyyyy & sLastUpDay & "_" & sFname 
        sFname = Dir()
    Loop

    Set fso = Nothing

Proc_EXIT:
    DoCmd.SetWarnings 1
    Exit Sub
ErrProc:
    MsgBox Err.Number & " " & Err.Description
    Resume Proc_EXIT
End Sub





 
 
【このカテゴリーの最新記事】
 
 
 
 

no image



[Access vba] ファイル出力フ..


 
 
 

no image



[Access vba] サブフォームで..


 
 
 

no image



[Access vba] ファイル名の最..


 
 
 

no image



[Access vba] DoCmd.R..


 
 
 

no image



[Access vba] フォームにある..