ファイル 文字操作テキストファイル出力バックアップ用CSV形式

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][ファイル 文字操作テキストファイル出力バックアップ用CSV形式]

Option Explicit

Sub AddCSV()

'超簡単
'’CSV形式テキストファイル出力
'コード中の「''」は仕様書用記号(弊社用)

On Error GoTo error:

Application.ScreenUpdating = False

If MsgBox("バックアップを開始します。この処理には環境により数十秒要することもあります。" & vbCr & vbCr & _
"バックアップを開始しても宜しいですか?", vbOKCancel, "バックアップ開始確認") = vbCancel Then Exit Sub

Dim sht(1 To 2) As Worksheet ''
Dim bok As Workbook ''

Dim Mypath As String ''
Dim I, FileName ''

Const shtFol As String = "Backup" ''***バックアップフォルダ名の指定***

Dim MyFileNAME(1 To 2) As String ''***2つのEXCELデータベース***

Dim sht_col_count As Long '’
Dim sht_row_count As Long '’

Dim Myrow As Long ''
Dim Mycol As Long ''

Dim ThisSTR As String ''

Set bok = Workbooks(SubBook) ''***BOOKの指定の指定***
Set sht(1) = bok.Worksheets("会計伝票") ''***SHEETの指定1***
Set sht(2) = bok.Worksheets("カルテ") ''***SHEETの指定2***

MyFileNAME(1) = sht(1).Name & ".txt" ''
MyFileNAME(2) = sht(2).Name & ".txt" ''

Mypath = bok.Path

Dim x As Byte


'----------->開始<-------------
For x = 1 To 2

''ターゲットシートの数
sht_col_count = sht(x).Range("a1").CurrentRegion.Columns.Count
sht_row_count = sht(x).Range("a1").CurrentRegion.Rows.Count

FileName = Mypath & "\" & shtFol & "\" & MyFileNAME(x) ''ファイル名を作成。

I = 1 ''

Open FileName For Output As #I ' ファイルを開。

For Myrow = 1 To sht_row_count ' ’書き込み開始ループ(フィールド含む)

ThisSTR = ""

For Mycol = 1 To sht_col_count
ThisSTR = ThisSTR & sht(x).Cells(Myrow, Mycol).Value & ","
Next Mycol

Print #I, ThisSTR ' ファイルに文字列を書き込み。

Next Myrow

Close #I

Next x

Set bok = Nothing ''
Set sht(1) = Nothing ''
Set sht(2) = Nothing ''


MsgBox "バックアップを完了しました。" & vbCr & vbCr & _
"作成場所 : " & Mypath & "\" & shtFol & "\", 0, "バックアップ完了"

Exit Sub

error:
MyErrorMsg '’サブルーチンにて作成

End Sub
 





Production Japan Import Application. Since 1998