Ｐａｇｅ 842 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ ＩＮＤＥＸ ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼圧縮後のファイル名に日付を入れたい 日付 03/3/6(木) 18:55 ┗Re:圧縮後のファイル名に日付を入れたい りん 03/3/6(木) 23:35 ─────────────────────────────────────── ■題名 ： 圧縮後のファイル名に日付を入れたい ■名前 ： 日付 ■日付 ： 03/3/6(木) 18:55 -------------------------------------------------------------------------
| 以前に教えて頂いたコードを元に、*.xlsファイルを複数まとめて、 LHA圧縮後、保存("C:\My Documents\test.lzh")する事が出来たのですが、 マクロを実行するたびに、 "C:\My Documents\test 2003-3-6 Thu.lzh" "C:\My Documents\test 2003-3-6 Thu (2).lzh" "C:\My Documents\test 2003-3-6 Thu (3).lzh" . . と、その時点の日付と、連番を振る方法がわかりません。 どうかアドバイスをよろしくお願いいたします。 'LHA圧縮のコード Dim Result As Integer Dim Command As String Dim RetMsg As String * 255 Const FlNam = "D:\会社\*" Const LzNam = "C:\My Documents\test.lzh" On Error Resume Next Kill "C:\My Documents\test.lzh" Command = "a -d1 -jp1 -gn2 -jm4 -w0 -jf0 -jxD:\会社 " & """" & LzNam & """" & " " & """" & FlNam & """" Result = Unlha(0, Command, RetMsg, 255) If Result = 0 Then 'Call SFX Else 'Call BackUp End If '日付と連番を振るコードのつもり Dim str1 As String Dim strn As String Dim strjp As String Dim strjp2 As String str1 = "C:\My Documents\" & Format$(Date, "yyyy-M-D ddd") strjp = Format$(Date, "yyyy年M月D日 aaa曜日") strjp2 = Format$(Time, "am/pm h:00") If (Len(Dir(str1 & ".lzh")) > 0) Then n = 2 Do strn = str1 & " (" & n & ")" & ".lzh" If (Len(Dir(strn)) = 0) Then Exit Do n = n + 1 Loop |
| 日付 さん、こんばんわ。 >以前に教えて頂いたコードを元に、*.xlsファイルを複数まとめて、 >LHA圧縮後、保存("C:\My Documents\test.lzh")する事が出来たのですが... ほとんどそのまま大丈夫なようでしたが、ファイル名作成の部分だFunctionにして分離しました。MyDocumentsの実際のフォルダ名はOSに依存して変わったりするので、FSOで取得してあります（過去ログのをちょっと修正）。 Sub test() '実行するのはこれ On Error Resume Next Dim WsSh As Object, Mpath As String Set WsSh = CreateObject("Wscript.Shell") If Err Then MsgBox "Wscript.Shellがありません", vbCritical, "あれ？" Else Dim Newname As String, wb As Workbook, II% 'MeではC:\Mydocumentsではないため Mpath = WsSh.SpecialFolders("MyDocuments") '5回新規ブックを作成して保存してみる For II% = 1 To 5 Set wb = Workbooks.Add Newname = DateName(Mpath, ".xls") With wb.Worksheets(1) .Cells(1, 1).Value = II% .Cells(2, 1).Value = Now End With wb.SaveAs Newname wb.Close Set ws = Nothing Next End If ' Set WsSh = Nothing End Sub Function DateName(Pname As String, ext As String) As String 'ファイル名を作る関数 Dim str1 As String, strn As String 'フォルダ名の右端は \ が必要 If Right(Pname, 1) <> "\" Then Pname = Pname + "\" '拡張子の左端は . が必要 If Left(ext, 1) <> "." Then ext = "." + ext ' 'ファイル名に空白を入れるのはあんまりよろしくないので '(何かあったときに救済しづらい) str1 = Pname & Format$(Date, "yyyy-M-D-ddd") ' n = 2 strn = str1 & ext Do If Dir(strn) = "" Then Exit Do strn = str1 & "(" & n & ")" & ext n = n + 1 Loop DateName = strn End Function こんな感じです。 関数DateNameの引数は引数１がフォルダ名を示す文字列、引数２が拡張子を示す文字列です。 |