[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『【VBA】ファイルのコピーとCSV書き出し』（山九）
VBA勉強中の駆け出しです。
「バックアップ」フォルダにファイルをコピーして、「書き出しデータ」フォルダにCSV出力を行おうとしているのですが、「アプリケーションまたはオブジェクトの定義エラーです。」エラーが出てしまいます。
Option Explicit
Sub ファイルコピーとCSV書き出し()
'バックアップファイル Dim ws, FileName, ExportFileName ws = ActiveWorkbook.Name FileName = Format(Now(), "yyyymmdd") & "_" & ws ExportFileName = Format(Now(), "yyyymmddhhmmss") & "_書き出し.csv"
'バックアップ元・先・書き出しファイル名
Dim Moto, Saki, Exp
Moto = ThisWorkbook.Path & "\" & ws 'バックアップ元のファイルパス
Saki = ThisWorkbook.Path & "\バックアップ\" & FileName 'バックアップ先のファイルパス
Exp = ThisWorkbook.Path & "\書き出しデータ\" & ExportFileName 'CSVのファイルパス
'参照設定
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'コピー&CSV書き出し
FSO.CopyFile Moto, Saki, True
ThisWorkbook.SaveAs ThisWorkbook.Path & Exp, xlCSV
'後片付け
Set FSO = Nothing
End Sub
どこをどう直せばよいか正解へお導き下さい。
厚かましいお願いで恐縮です、よろしくお願いします！
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
これで解決するかはわからないが気になったところを。 >Exp = ThisWorkbook.Path & "\書き出しデータ\" & ExportFileName 'CSVのファイルパス >ThisWorkbook.SaveAs ThisWorkbook.Path & Exp, xlCSV Expにはパス情報も入っているのでThisWorkbook.Pathはいらないのでは？ （ねむねむ） 2021/09/21(火) 13:37
（山九） 2021/09/21(火) 13:48
1行目を削除して、CSVで書き出した後、保存しないで閉じる （- -） 2021/09/21(火) 14:28
Dim ws, FileName, ExportFileName Dim Moto, Saki, Exp
↑のような書き方は↓と同じ意味になります。
Dim Moto As Variant, Sak As Varianti, Exp As Variant Dim ws As Variant, FileName As Variant, ExportFileName As Variant
特に問題があるわけではありませんが、慣れてきたら【型】もきちんと指定できるようになるとよいですね。
■２
ThisWorkbook.SaveAs ThisWorkbook.Path & Exp, xlCSV ↑だと【自ブック】をCSV形式で保存することになります。 好みの問題かもしれませんが、【シートを新規ブックにコピー】してそのブックを保存するようにするのもアリだとおもいます。
■３
ということを踏まえて、最初のコードを整理すると↓のような感じでもよいですね。
注1 「ActiveWorkbook」と「ThisWorkbook」が同じものだと解釈しています 注2 テストはしていません。ミスっていたらごめんなさい。
Sub 整理()
Stop 'ブレークポイントの代わり
With ThisWorkbook
'▼FileSystemObjectでファイルをコピー
CreateObject("Scripting.FileSystemObject").CopyFile _
Source:=.FullName, _
Destination:=.Path & "\バックアップ\" & Format(Now(), "yyyymmdd") & "_" & .Name, _
Overwrite:=True
'▼シートを新規ブックにコピー
.Worksheets(1).Copy
'▼↑で作成されたブックをcsv形式で保存して閉じる
Workbooks(Workbooks.Count).SaveAs _
FileName:=.Path & "\書き出しデータ\" & Format(Now(), "yyyymmddhhmmss") & "_書き出し", _
FileFormat:=xlCSV
Workbooks(Workbooks.Count).Close False
End With
End Sub
■４
＞2行目からをCSV出力したい場合は、どう記述すれば良いでしょうか？
既に提示のある案でもよいですし、
(1)新規ブックを開く (2)データ元ブック（自ブック）の２行目以降をコピーする (3)(1)で用意したブックのA1セルに貼付する (4）↑を保存する
のようにしてもよいですね。
ちなみに、(1)～(4)いずれも【マクロの記録】で必要となる命令が調べられます。
（もこな２） 2021/09/21(火) 15:42
Dim targetRange As Range
Dim wb As Workbook
Dim sheetName As String
sheetName = ActiveSheet.Name 'アクティブシート名
Set targetRange = Worksheets(sheetName).Range("A2").CurrentRegion 'アクティブシートの指定行からコピー
Set wb = Workbooks.Add '新規ブックを開く
targetRange.Copy wb.Worksheets(1).Range("A1") 'CSVファイルへ出力する範囲を新規ブックへコピー
wb.SaveAs FileName:=Exp, FileFormat:=xlCSV 'CSVで書き出し
（山九） 2021/09/22(水) 09:12
書き出し結果が、フィルターしたものではなく、全て表示されてしまいます。
ネットで調べた内容を引用しますと、
「CurrentRegionは「どこかのセル.CurrentRegion」と書いて、指定した「どこかのセル」を含むひとかたまりのセル範囲を返します。表の中で「Ctrl + Shift + *」を押したのと同じ状態です。」
と書かれているのですが、Set targetRange で指定しているのにダメです・・・
どこが間違っているのでしょうか？
（山九） 2021/09/22(水) 10:59
（tkit） 2021/09/22(水) 11:40
CurrentRegionは、表（とExcel君が判断した）範囲を取得します。
それは、Rangeオブジェクトにセットしようがしまいが関係ありません。
したがって、１行目も含めて表範囲だと認識されるような状態であれば「Range("A2").CurrentRegion」
としたところで例えば↓のような表であればA1:C4のように【１行目】も含まれることになります。
___A___ __B___ __C____ 1 項目１ 項目２ 項目３ 2 い ろ は 3 に ほ へ 4 と ち り
■６
＞書き出し結果が、フィルターしたものではなく
唐突にフィルターの話が出てきましたが、フィルターと呼ばれるものにもいくつか種類があるのでそれをはっきりさせたほうがよいです。
このうち【オートフィルタ】であれば、コピーした場合は可視セル（≒抽出されている行）が対象となる仕組みです。
（20年以上前のバージョンであれば、可視セルを明示的に指定する必要がありましたが現在は仕様変更されています）
また、オートフィルタはシートに１つしか設定できません。
逆の観点でいうと、シートにオートフィルタが設定されていれば、そのセル範囲は調べることができます。
Sub 研究用1()
Debug.Print ActiveSheet.AutoFilter.Range.Address
End Sub
ただし、「AutoFilter.Range」には項目行も含まれることとなります。
なので、もしも見出し行を除いてコピペしたいということであれば↓のようにOffsetプロパティを使って１行下げるようにするとよいでしょう。
Sub 研究用2()
Debug.Print ActiveSheet.AutoFilter.Range.Offset(1, 0).Address
End Sub
１行下げることにより空白行が余分に含まれることとなりますが、コピペだけであれば空っぽの行が最後にくっついたとしても大した問題ではないでしょう。
（Intersectメソッドを使えば問題は回避できますが、問題がないのにややこしくする必要はないとおもいますので説明は省略します）
■７
＞下の記述を加えていけました！
話が前後しますが、↑のように仰ってますが、Sub～End Subまでが一つのプロシージャというかたまりなので、提示されるのであればすべて提示されたほうが、お互いに誤解が無くてよいとおもいます。
この観点で提示されている部分だけ見ると変数「Exp」の宣言も取得もされてないので空っぽになっちゃってますよ。
さらに、同じブックの中でのことだとおもうので↓は回りくどいように思います。
sheetName = ActiveSheet.Name 'アクティブシート名
Set targetRange = Worksheets(sheetName).Range("A2").CurrentRegion
↑おなじことですよね↓
Set targetRange = ActiveSheet.Range("A2").CurrentRegion
よって、当初の【2行目からをCSV出力】ということを考えるだけならばこんな感じでもよかったとおもいます。
Sub 研究用3()
Dim コピー範囲 As Range
Stop 'ブレークポイントの代わり
With ActiveSheet
Set コピー範囲 = Intersect(.UsedRange, .Rows("2:" & .Rows.Count))
End With
If Not コピー範囲 Is Nothing Then
コピー範囲.Copy Workbooks.Add.Worksheets(1).Range("A1")
With Workbooks(Workbooks.Count)
.SaveAs _
Filename:=ThisWorkbook.Path & "\書き出しデータ\" & Format(Now(), "yyyymmddhhmmss") & "_書き出し", _
FileFormat:=xlCSV
.Close False
End With
Else
MsgBox "コピー対象のデータがありません"
End If
End Sub
■８
＞VBA勉強中の駆け出しです。
既に助言がありますが「おかしいな？」と思ったら、ご自身で検証してみる癖をつけるとよいと思います。
また、ネット検索で見つけたり、質問掲示板で回答のあったコードについてもただ実行してみるのではなく、どこで何をしているのかなどを研究されると理解が深まります。
この検証や研究について【ステップ実行】という方法を使うと、１行ずつ確認しながらコードを実行することができますのでお勧めです。
よって、ステップ実行という言葉を聞いたことがなければ↓を読んでみてください。
【ステップ実行】 https://www.239-programing.com/excel-vba/basic/basic023.html http://plus1excel.web.fc2.com/learning/l301/t405.html
また、以下も知っておいて損は無いと思います。
【イミディエイトウィンドウ】 https://www.239-programing.com/excel-vba/basic/basic024.html https://excel-ubara.com/excelvba1/EXCELVBA486.html
【ローカルウィンドウ】 https://excel-ubara.com/excelvba4/EXCEL266.html http://excelvba.pc-users.net/fol8/8_2.html
【ブレークポイント】 https://www.239-programing.com/excel-vba/basic/basic022.html https://www.tipsfound.com/vba/01010
■９
上記のほか、こだわりが無ければ【インデント（字下げ）】をつけると、コードが見やすくなり、全体の構造が把握しやすくなることでご自身のデバッグ作業の効率アップにつながるとおもいますから検討されてみるのもよいかもしれません、
（もこな２ ） 2021/09/22(水) 12:57
もこな２さん、何度もすごく丁寧にご返事いただいて頭が上がりません・・・
質問するにしても分かってくれていると勝手に想像して省略するの、本当ダメですよね、すみませんでした！
色々ご紹介いただいたリンク、お気に入りに入れて、今回、お教えいただいた内容、メモ帳に保存していつでも見返せるようにして、何度も繰り返し頭に叩き込まれるようにします！！！
本当に本当にありがとうございました！！！！m(__)m
（山九） 2021/09/22(水) 17:45
Sub 研究用4()
'▼１行目も含めてシート丸ごと新規ブックへコピー
ActiveSheet.Copy
With Workbooks(Workbooks.Count).Worksheets(1)
'▼後ほど１行目を削除するので、数式などの結果が変わらないための対策（そのようなことがなければ不要）
.UsedRange.Value = .UsedRange.Value
'▼作業の肝（１行目を削除する）
.Rows(1).Delete
'▼保存して閉じる
.Parent.SaveAs _
Filename:=ThisWorkbook.Path & "\書き出しデータ\" & Format(Now(), "yyyymmddhhmmss") & "_書き出し", _
FileFormat:=xlCSV
.Parent.Close False
End With
End Sub
もう見てないかもしれませんが、ふと思いついたので提示しておきます。
（もこな２ ） 2021/09/23(木) 15:50
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.