目次
SCHOOL OF VBA そのあとに その３
こんにちは。伊川(@naonaoke)です。
長らくお待たせしました。
さぼっていたわけではないのですが、時間をおいて申し訳ありませんでした。
今回は、作成したファイルを自動で保存します。
特殊フォルダの取得
作成したファイルをデスクトップに自動保存します。
その際に必要な知識は、WScript.Shell,SpecialFoldersプロパティです。
CreateObject関数で作成したWscript.ShellのSpecialFoldersプロパティで、
特殊フォルダを示す文字列を引数に指定して特殊フォルダを取得します。
デスクトップのフォルダ、スタートメニューのフォルダ、個人用ドキュメントのフォルダなどを取得できます。
自動保存 作業手順 その1 コード抜粋
CreateObject関数で作成したオブジェクトを利用するにはCreateObject関数の戻り値を
Setステートメントでオブジェクト変数に代入します。
この書き方でデスクトップを取得できます。
自動保存 作業手順 その3 コードを解説
Sheet2を選択
最終行を取得
条件分岐で判定する
もし、セルC2の文字数が、0以上だったら
出力範囲を設定します。
新しいシートを作成して、選択したデータを新しいシートにコピー
CSVで出力するコード
これで、自動でデスクトップに作成した数値が自動保存されます。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
Sub CSVファイルへ出力() Dim i As Long Dim rng As String Dim Path As String, WSH As Variant Set WSH = CreateObject("WScript.Shell") Path = WSH.SpecialFolders("Desktop") & "\" Sheets(2).Activate maxrow = Cells(Rows.Count, 4).End(xlUp).Row For i = 2 To maxrow If Len(Worksheets(2).Range("C2")) > 0 Then Worksheets(2).Range("C2:U13").Select rng = Selection.Address '選択範囲のセルアドレス sname = Worksheets(2).Name 'シート名 Worksheets(sname).Range(rng).Copy Destination:=Worksheets.Add.Range("A1") '新しいシートを追加し、選択範囲をコピー ActiveSheet.Move '新しいブックを作成し、そこにシートを移動する Application.DisplayAlerts = False '上書きのメッセージを表示させない ActiveWorkbook.SaveAs Filename:=Path & Left(ActiveSheet.Range("A2"), 14), FileFormat:=xlCSV ActiveWorkbook.Close SaveChanges:=False '保存せずに閉じる Application.DisplayAlerts = True 'メッセージ表示を戻す Set WSH = Nothing End If Next i MsgBox "出力完了" End Sub |
ここがポイント
ここがポイント
全自動で保存されます。名前を付けて保存等、面倒な作業を依頼すると売れません。最初は、何時間も考えました。一度覚えると、カンタンなもので、パーツを組み合わせる感覚です。
まとめ
一応、ACCESSへの転送等もあるのですが、それは、一般公開の動画で紹介しています。
ここでは、割愛します。
