excelのVBA練習について 2018年9月21日


主な目的はファイル移動及びファイル名変更、が目的です。
この後の展開としては、メールで送るというものと、送った後別途フォーム表示をしてその上で、また別のメールを送るというものを作成するためのファイル処理のコードです。

目新しさは無いですね。以前作成していますし。
とりあえずはここまで。


Sub filemoverename()
Application.ScreenUpdating = False
   
Dim SavDir, FolderName, SavDir0 As String
Dim hidut, dayd2 As String
Dim days As Date
Dim years, monthd, dayd, SheNem As Long
   

years = Year(Range("B2"))
monthd = Month(Range("B2"))
dayd = Day(Range("B2"))




 If monthd < 10 Then
       
        month0 = years2 & "0" & monthd
    Else
       month0 = monthd
End If



 If dayd < 10 Then
       
        dayss1 = "0" & dayd
    Else
       dayss1 = dayd
End If
SheNem = years & month0 & dayss1
'dayd2 = years & "年" & month0 & "月" & dayss1 & "日"
hidut = "今日は何の日_" & SheNem
yearsmonth = years & "年" & month0 & "月"

If ActiveSheet.Range("B4") = "桜" Then
   SavDir0 = "C:\Users\Desktop\vba\たこ\"

           FolderName = SavDir0 & yearsmonth
         
           If Dir(FolderName, vbDirectory) = "" Then 
               MkDir FolderName
           Else
             
           End If

SavDir = FolderName & "\"

ElseIf ActiveSheet.Range("B4") = "胃腸" Then
SavDir0 = "C:\Users\Desktop\vba\串\"
 
           FolderName = SavDir0 & yearsmonth
         
           If Dir(FolderName, vbDirectory) = "" Then   '
               MkDir FolderName
           Else
             
           End If
           SavDir = FolderName & "\"

         
Else
SavDir = "C:\Users\Desktop\vba\"
End If

Name ActiveSheet.Range("B1") As SavDir & hidut & ".pdf"

SentFil = SavDir & hidut & ".pdf"

MsgBox  SentFil & "保存しました!!!"
End Sub

コメント

このブログの人気の投稿

エクセルマクロをすこし 2018年8月25日 リストから別のリストを作成