• 締切済み

CSVの出力（1行を3行に出力～）

テキスト式1行 200705 00001 A01 A02 B01 B02 C01 C02があるとします。 200705と00001は3行の先頭を出したいので、どうやってループさせたらいいのかわからないのです。 今の状況 Private Sub Object(lFname As String, lOFilename As String) Dim IUO As Variant ''出力データ Dim lFBnt As Long ''開始位置１ Dim m_Input As String ''レコード退避先データ Dim byteInput() As Byte ''領域確保変数 Dim fs As Object ''ファイルシステムオブジェクト Dim ObjOutFile As Object ''出力先ファイルオブジェクト'' IUO = "" ''出力先ファイルオブジェクトの作成 Set fs = CreateObject("Scripting.FileSystemObject") ''出力先ファイル名の指定 Set ObjOutFile = fs.CreateTextFile(lOFilename, True) ReDim byteInput(レコードの長さ- 1) ''正常ファイル時のファイルオープン Open lFname For Binary As #1 '' ファイルの終端までループを繰り返します。 Do While Loc(1) < LOF(1) IUO= "" ''該当行のレコードデータの取得 Get #1, , byteInput m_Input = StrConv(byteInput, vbUnicode) lFBnt = 1 IUO = IUO + Chr(39) & MidMbcs(m_InputBuffer, lFBnt, 一つ目のパラメータ名) + Chr(39) lFBnt = lFBnt + 一つ目のパラメータ名 IUO = IUO + vbNewLine ''改行 ''ファイルへの書込 ObjOutFile.Write (IUO) Me.Refresh Loop Close #1 ''File close ObjOutFile.Close Set ObjOutFile = Nothing End Sub 以上では1行しか出力できないのですが、どうやったら3行出力できるのでしょうか。 よろしくおねがいします。

みんなの回答

  • loop_dog
  • ベストアンサー率32% (14/43)
回答No.1

>200705 00001 A01 A02 B01 B02 C01 C02 >200705と00001は3行の先頭を出したいので が、よく意味が分かりません。＜特に『３行の先頭』 データ加工の仕様というのはどんな感じなんでしょうか？ 200705,00001,A01,A02,B01,B02,C01,C02 にしたいのではなくて、 例えば、 200705 00001 A01 というようにしたいということですか？

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • CSV形式で出力後、開くときの警告メッセージについ

    いつもお世話になっております。 ACCESSからデータをCSV形式で出力後、ファイルを開くときに添付のような警告メッセージが表示されます。[はい]をクリックすればファイルは開くことができるのですが、警告メッセージが表示されないようにするにはどうしたらいいでしょうか？ xlsxのテンプレートを開き、そこにデータを書き出して、csvで保存するようになっています。csv形式で出力したことがないので、csvのFormatを指定する必要があると思っていますが、どうしたらいいでしょうか？ ご教授お願いいたします。 Private Sub CMD_Expo_DblClick(Cancel As Integer) On Error GoTo Err_FileDialog_Click Dim strsql As String Dim strTemplate As String Dim strFileName As String Dim ExpFileName As String Dim xlapp As Object Dim xlWB As Object Dim myCn As New ADODB.Connection Dim myRs As New ADODB.Recordset 'ファイル名作成 ExpFileName = "SNDFILE" & Format(Date, "yyyymmdd") strFileName = GetFileName(False, "", "", ExpFileName & ".csv") 'EXCELアプリケーションを起動 Set xlapp = CreateObject("Excel.Application") 'セットする過程が見えないよう一旦不可視 xlapp.Visible = False Set myCn = CurrentProject.Connection strsql = "Q_BOFAXExpo_MJ" 'レコードセットオープン myRs.Open strsql, myCn, adOpenForwardOnly, adLockReadOnly With xlapp 'テンプレートを開く strTemplate = Application.CurrentProject.Path & "\" & "SNDFILE.xlsx" Set xlWB = .Workbooks.Open(strTemplate) 'テンプレートファイルが存在しないときはエラー If Dir(strTemplate) = "" Then MsgBox "テンプレートファイルを確認してください。", vbOKOnly + vbCritical, "エラー" .Visible = True .Quit Exit Sub End If 'テンプレートファイルオープン .Workbooks.Open strTemplate '結果値出力処理(1行目にヘッダーを表示しているので、2行目1列目からセット xlWB.Worksheets("Sheet1").Cells(1, 1).CopyFromRecordset myRs '完了したら保存 If Len(strFileName) = 0 Then xlWB.Close SaveChanges:=False xlapp.Quit MsgBox "処理を中止します。", vbOKOnly + vbInformation Exit Sub Else xlWB.SaveAs FileName:=strFileName End If MsgBox "BOFAX用のファイルの出力が完了しました。", vbOKOnly + vbInformation End With Set myRs = Nothing: Close Set myCn = Nothing: Close 'Excelを終了します xlapp.Quit Exit Sub Exit_FileDialog_Click: Exit Sub Err_FileDialog_Click: MsgBox "予期せぬエラーが発生しました" & Chr(13) & _ "エラーナンバー：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbOKOnly End Resume Exit_FileDialog_Click End Sub

  • ACCESSのCSV出力に関して

    教えて下さい。 ACCESSであるテーブルのデータをCSV出力しようとして、以下のような記述をしました。 結果、問題なく出力されましたが、データだけでなく、項目も出力しようと考えています。 その際にはどのような記述をすれば良いでしょうか？ 初歩的な質問で申し訳ありません。 教えて下さい。 《内容》 Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim stSQL As String Dim stTBL As String Dim myWSH As Object 'WScript Dim myDesktopPath As String Dim stPath As String 'フルパス Dim objFSO As Object 'FileSystemObject Dim fsoTS As Object 'TextStream Dim tmp As Variant 'データ Dim re As Variant 'データ件数 Dim stDocName As String Const ForAppending = 8 stTBL = "t_合算" 'テーブル名 '開始メッセージ stDocName = "「" & stTBL & ".CSV」 ファイルをデスクトップに作成します" If MsgBox(stDocName, vbYesNo) = vbNo Then Exit Sub 'デスクトップパス取得 Set myWSH = CreateObject("WScript.Shell") myDesktopPath = myWSH.SpecialFolders("Desktop") Set myWSH = Nothing 'フルパス stPath = myDesktopPath & "\" & stTBL & ".CSV" '読み取り専用でセット Set cnn = CurrentProject.Connection stSQL = "SELECT * FROM " & stTBL Set rst = cnn.Execute(stSQL) If rst.EOF Then stDocName = "出力するデータがありませんでした" Else '文字列データ格納 (全データ出力、カンマ区切り) tmp = rst.GetString(adClipString, , ",", vbNewLine) '出力 Set objFSO = CreateObject("Scripting.FileSystemObject") With objFSO If .FileExists(stPath) Then '既存ファイル削除 Call .DeleteFile(stPath) End If Set fsoTS = .OpenTextFile(stPath, ForAppending, True) '文字列一括書き出し fsoTS.WriteLine tmp re = fsoTS.Line - 2 End With Set fsoTS = Nothing: Set objFSO = Nothing stDocName = re & " 件の CSVデータを出力しました。" End If MsgBox stDocName, vbOKOnly

  • CSV取込みで最終行を取り込まない方法

    CSVの取込みで1行目のヘッダーと最終行のフッターを取り込まず 2行目～最終行の前までの中身だけを取り込みたいのですが、 1行目をスキップする方法は、下記を参照にしてなんとかできましたが、 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1230200277 ここに最終行をはぶくという処理をいれるにはどういたらいいでしょうか？ ---------------- Private Sub コマンド0_Click() Dim FSO As Object Dim InFile As Object Dim Outfile As Object Dim CsvPath As String Dim WorkPath As String Dim i As Long Const skipRow = 1 ''1行読み飛ばしの1 ''元のCSVファイルのフルパスに変更して！ CsvPath = "C\JPデータ取込CSV.csv" ''新しく作るCSVファイル。このMDBがあるフォルダにWork.csv 名で作られます。 WorkPath = CurrentProject.Path & "\Work.csv" '' FileSystemObjectのセット Set FSO = CreateObject("scripting.FileSystemObject") Set InFile = FSO.OpenTextFile(CsvPath, 1) Set Outfile = FSO.createTextFile(WorkPath) '' 読み飛ばし設定 For i = i To skipRow InFile.SkipLine Next i ''新しいCSVファイル作成 Outfile.Write InFile.ReadAll ''CSVファイルの終了と解放処理 Outfile.Close InFile.Close Set Outfile = Nothing Set InFile = Nothing ''Work.CSVファイルのインポート（今のDocmd以下をコピーし、ファイル名等を変更！） 'DoCmd.TransferText ・・・・・・ DoCmd.TransferText acImportDelim, "JPご清算書インポート定義", "T01_JPご精算書", WorkPath, True ''使用済みのWork．CSVを削除 FSO.DeleteFile WorkPath ''FileSystemObjectの解放 Set FSO = Nothing MsgBox "取り込み完了" End Sub

  • VB　テーブルのデータを出荷先ごとにcsv出力

    お世話になります。 VBは素人で、自分なりにネットでいろいろ調べて、下記の物を作ってみたのですが、 うまくいかず、とても悩んでおります。 知ってる方、どなたか教えて頂けませんか？ よろしくお願いいたします。ｍ(_ _)ｍ ------------------------------------------------------------------ 目的： (1)テーブルのフィルド名を、各CSVの一行目に出力したい。 (2)テーブルのフィルドは30項目ぐらいあるため、下記のように個別出力ではなく、 　　一括で出力できるようにしたいです。 (3)すべての項目には、”　”で囲み、カンマで区切りをしたいです。 ------------------------------------------------------------------ Option Compare Database Option Explicit Private objDB As DAO.Database Private objExcel As Object 'EXCELオブジェクト Private objWorkBook As Object 'WORKBOOKオブジェクト Private objSheet As Object 'SHEETオブジェクト Public Sub CSVsyuturyoku() Dim db As DAO.Database Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim flag As Boolean Set db = CurrentDb Set rs1 = db.OpenRecordset("SELECT DISTINCT 氏名 FROM 出荷データ") Do Until rs1.EOF Set rs2 = db.OpenRecordset("SELECT * FROM 出荷データ" _ & " WHERE Nz(氏名) = '" & rs1!氏名 & "'") flag = True Open CurrentProject.Path & "\ファイル" & rs1!氏名 & ".csv" _ For Output As #1 Do Until rs2.EOF 'Print #1, Nz(rs2!商品名) Print #1, rs2!商品コード & "," & rs2!商品名 & "," & rs2!単価 ' ↑フィルド項目数が多すぎたため、全部書ききらず。。。 rs2.MoveNext Loop Close #1 rs1.MoveNext Loop rs1.Close: Set rs1 = Nothing If flag Then rs2.Close: Set rs2 = Nothing db.Close: Set db = Nothing ' 終了の表示 MsgBox "ファイル出力が完了しました。" End Sub

  • ＶＢ6.0にて、ＣＳＶファイルを読み込もうとしているのですが、1行ずつ

    ＶＢ6.0にて、ＣＳＶファイルを読み込もうとしているのですが、1行ずつ読み込めません。 以下のコードで、Lineのメッセージボックスが表示されないのです。 どなたか教えていただけないでしょうか。よろしくお願いします。 'ＣＳＶファイル読み込み Sub Stream() Dim Line, Temp As Variant Dim objFSO As Object Dim objStream As Object Const ForReading = 1, ForWriting = 2, ForAppending = 3 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objStream = objFSO.OpenTextFile(strDFpath & strDFname(1), ForReading, False) Temp = objStream.ReadAll MsgBox Temp '最後の行までループ Do Until objStream.AtEndOfLine - 1 <> True '1行読む Line = objStream.ReadLine MsgBox Line Loop objStream.Close Set objStream = Nothing Set objFSO = Nothing End Sub

  • access 特定のレコード数までエクセルに出力したら、別のシートに出力先を変えたい

    VBA初心者です。宜しくお願い致します。 テーブルのデータをエクセルに出力しているのですが 特定の行まで出力したら、別のシートに出力先を変更したいのです。 以下コードの★部分で処理するのではないかと思っているのですが どのように書けばいいのかさっぱりわからず、ご質問させて いただきました。 どうぞ、宜しくお願い致します。 ----------------------- '既存の Excel Book をテンプレートとして開き、 '位置を指定して、テーブルのデータを出力 Dim cnADO As ADODB.Connection 'ADO コネクション確立 Dim rsADO As ADODB.Recordset Dim xls As Excel.Application Dim wkb As Excel.Workbook Dim fName As Variant Dim stDetail As String 'Query OR Table Name Dim stPath As String 'mdb & Excel Book Path Dim stXLName As String 'Book Name Dim stSheet As String 'Sheet Name Dim stSheet2 As String 'Sheet2 Name Dim stRng As String 'Range Address stPath = "\\marketing\"　'自mdb & Excel Book のパス stXLName = "marketing.xls" 'テンプレート用の Book stDetail = "出力テーブル" 'テーブル名 stSheet = "marketing" '出力するシート名１ stSheet2 = "marketing2" '出力するシート名２ stSheet3 = "marketing3" '出力するシート名３ stRng = "A26" '出力開始セル番地 Set cnADO = CurrentProject.Connection Set rsADO = cnADO.Execute(stDetail) 'テンプレート としてオープン Set xls = CreateObject("Excel.Application") xls.Workbooks.Add template:=stPath & stXLName Set wkb = xls.Workbooks(1) '★rsADOのレコード数を1行目のデータから30行目までに制限 '★明細データ貼り付け１（rsADOの1行目のデータから30行目までを貼り付け処理） With wkb.Worksheets(stSheet) .Range(stRng).CopyFromRecordset Data:=rsADO End With '★rsADOのレコード数を31行目のデータから75行目までに制限 '★明細データ貼り付け２（rsADOの31行目のデータから75行目までを貼り付け処理） With wkb.Worksheets(stSheet2) .Range(stRng).CopyFromRecordset Data:=rsADO End With '★rsADOのレコード数を76行目のデータから100行目までに制限 '★明細データ貼り付け３（rsADOの76行目のデータから100行目までを貼り付け処理） With wkb.Worksheets(stSheet3) .Range(stRng).CopyFromRecordset Data:=rsADO End With 'Excel画面を表示して終了(保存しない) xls.Visible = True Set xls = Nothing Set wkb = Nothing Set fName = Nothing rsADO.Close: Set rsADO = Nothing cnADO.Close: Set cnADO = Nothing

  • アクセスVBA CSVへ出力後、最終レコードの次の行に任意の文字を入れたい

    VBA超初心者です。宜しくお願いします。 今回は、テーブルからエクセルへ出力後、最終レコードの次の行に任意の文字を入れたいというのがわからず質問です。 全体の流れとしては、エクセル起動→テーブル名1を出力→テーブル名2を出力→CSV形式で保存となります。 このテーブル名2を出力した際の処理についてです。以下の記述の中で、”★★テーブル名2を貼り付け”の処理を追加、変更などする形で考えたいのですが、よい方法はございませんでしょうか？ 具体的には【テーブル名2をエクセルの任意の範囲に出力】→最終レコードの次行の特定の列を複数指定して任意の文字”END”を入れる。 （例：貼り付け開始がB25、データが3レコードであれば、28行目の任意の列（CとE）を指定して”END"といれる） なお、テーブル名2のレコード数は毎回ことなります。 説明不足の場合はご指摘ください。 御知恵を拝借したく宜しくお願いします。 --------------------------- Sub opnXLtmp3() On Error GoTo Err_opnXLtmp3 Dim cnn As ADODB.Connection Dim rst As ADODB.Recordset Dim cnn2 As ADODB.Connection Dim rst2 As ADODB.Recordset Dim stBasis As String Dim stDetail As String Dim xls As Excel.Application Dim wkb As Excel.Workbook Dim fName As Variant Dim stPath As String 'mdb & Excel Book Path Dim stXLName As String 'Book Name Dim stSheet As String 'Sheet Name Dim stRng As String 'Range Address stPath = CurrentProject.Path '自mdb & Excel Book のパス stXLName = "ファイル名.csv" 'テンプレート用の Book stBasis = "テーブル名1" 'テーブル名1 stDetail = "テーブル名2" 'テーブル名2 stSheet = "シート名" '出力するシート名 stRng = "B25" '出力開始セル番地 Set cnn = CurrentProject.Connection Set cnn2 = CurrentProject.Connection Set rst2 = cnn2.Execute(stBasis) Set rst = cnn.Execute(stDetail) 'テンプレート としてオープン Set xls = CreateObject("Excel.Application") xls.Workbooks.Add template:=stPath & stXLName Set wkb = xls.Workbooks(1) 　　'テーブル名1を貼り付け With wkb.Worksheets(stSheet) .Cells(3, 10) = rst2("番号") End With '★★テーブル名2を貼り付け With wkb.Worksheets(stSheet) .Range(stRng).CopyFromRecordset Data:=rst 　　　'ここに .Cells(X, 3) = "END" じゃだめでした。 　　　'ここに .Cells(X, 5) = "END" じゃだめでした。 End With 'Excel画面を表示して終了(保存しない) xls.Visible = True fName = xls.Application.GetSaveAsFilename("ファイル名3" & rst2("番号"), _ "CSVファイル(*.csv),*.csv", 1) If fName <> False Then wkb.SaveAs FileName:=fName MsgBox "新規ブックは、「" & fName & "」の名前で保存しました！", vbOKOnly Else MsgBox "新規ブックは保存できませんでした。", vbOKOnly End If End Sub

  • エクセルからUTF8でファイルを出力する方法。

    エクセルのマクロでシートの内容をXMLに変換して出力するマクロを作成しています。ファイルオブジェクトを利用しているのですが、保存されたドキュメントがシフトJISとなってしまい、そのまま利用できません。 UTF8形式で保存したいのですが、どなたかサンプルなど提供していただけませんでしょうか？ 以下、作成中のサンプルコードです。 ---- Sub XMLMake(wksheetname As String) '列名取得 'ファイルオブジェクト作成 Dim objFile As Object Dim objTextFile As Object Dim strFileName As String Set objFile = CreateObject("Scripting.FileSystemObject") Set objTextFile = objFile.CreateTextFile("d:\" & wksheetname & ".xml", True) 'ルートノード作成 objTextFile.WriteLine ("<DATA>") 'ルートノード閉じ objTextFile.WriteLine ("</DATA>") 'ファイルオブジェクト保存 objTextFile.Close MsgBox ("ファイルを作成しました。:" & wksheetname & ".xml") End Sub

  • VB2008: ファイルから１行づつ読み込む関数のバグの修正方法？

    ' ========================================== '　全ての行を読み込んで "" 行以外を出力する ' ========================================== Module theGrap 　　Sub Main() 　　　　Dim iNow As Integer = 0 　　　　Dim iNext As Integer = 0 　　　　Dim aLine As String = "" 　　　　Do 　　　　　　iNow = iNext 　　　　　　aLine = FGets("D:\Temp\Test4.txt", iNow, iNext) 　　　　　　If aLine = "" Then Continue Do 　　　　　　Debug.Print(aLine) 　　　　Loop Until iNext = -1 　　End Sub End Module ［イミディエイト ウインドウ］ 123あいうえお90 123かきくけこ90 123さしすせそ90 と、成功しています。 ' -------------- '　行末まで読む ' -------------- Do 　　fs.Seek(iNowPosition, SeekOrigin.Begin) 　　fs.Read(aBuf, 0, 2) 　　aChar = ec.GetString(aBuf).Substring(0, 1) 　　If aChar <> Chr(13) Then 　　　　aChars &= aChar 　　Else 　　　　iNowPosition = iNowPosition - 1 　　　　Exit Do 　　End If 　　iNowPosition += txt.LenB(aChar) Loop While iNowPosition < fs.Length And (aChar <> Chr(13) Or aChar <> Chr(10)) しかし、実は、FGets 関数では１文字づつ読み込んでいます。 そこで、StreamReader で一行を読み込むように修正。 ［イミディエイト ウインドウ］ 123?????90 123?????90 123?????90 すると見事に化けてしまいました。 化けること自体は理解できるのですが、化けを修正する術がわかりません。 Function FGetl(ByVal aFile As String, _ 　　　　　　　 ByVal iNowPosition As Integer, _ 　　　　　　　 ByRef iNextPosition As Integer) As String 　　Dim aBuf(1) As Byte 　　Dim aChars As String = "" 　　iNextPosition = -1 　　If File.Exists(aFile) Then 　　　　Try 　　　　　　Using fs As FileStream = New FileStream(aFile, FileMode.Open, FileAccess.Read) 　　　　　　　　Dim sr As StreamReader 　　　　　　　　Dim ec As Encoding = Encoding.Default 　　　　　　　　fs.Seek(iNowPosition, SeekOrigin.Begin) 　　　　　　　　sr = New StreamReader(fs) 　　　　　　　　aChars = sr.ReadLine 　　　　　　　　iNowPosition += txt.LenB(aChars) 　　　　　　　　iNextPosition = NextPosition(fs, iNowPosition) 　　　　　　　　fs.Close() 　　　　　　　　Return aChars 　　　　　　End Using 　　　　Catch ex As IOException 　　　　　　MsgBox(ex.Message & "(FGets)", MsgBoxStyle.Exclamation, "エラー:") 　　　　　　Return "" 　　　　End Try 　　Else 　　　　Return "" 　　End If End Function 文字の化けを修正する方法を教えて頂ければ幸いです。

  • EXCEL VBAでのCSVファイル読み込み、出力で困っています。

    EXCEL VBAでのCSVファイル読み込み、出力で困っています。 データ３件のファイルから３件抽出すると正常にイミディエイトウィンドウへ表示されるのですが データ約３８，０００件のファイルから３件抽出すると文字化けする項目があるのです。 文字化けする項目の共通点は256文字以降が、どうやら化けているようです。（長文１、長文２の項目） 教えて！goo でいろいろ探してみましたが、これといった解決策が見つかりませんでした。 また、抽出データをCSVで出力しているのですが 始まりと終わりに " が出力されるので困っています。 " が出力されないようにできるのでしょうか？ 当方、COBOLでのコーディング経験は実務で４年ほどありますが VBAの知識は学校で少し学んだ程度の初心者です。 わかりやすく教えていただけないでしょうか？ sample1.csv データ３件 sample2.csv データ約３８，０００件（ここにsample1.csvと同じデータが含まれています） Dim adoCON As New ADODB.Connection Dim adoRS As New ADODB.Recordset Dim rec As String 'ADOを使い読み込み専用モードでCSVファイルを扱う準備(オープン)をします adoCON.Open "Driver={Microsoft Text Driver (*.txt; *.csv)}; " & _ "DBQ=c:\Documents and Settings\デスクトップ\test;" & _ "ReadOnly=1" Open "C:\Documents and Settings\デスクトップ\test\test.csv" For Output As #1 'SQLを実行し、指定したIDのデータを抽出します 'ID,名前,,,,,,,,,,,長文１,長文２,,,,,,更新日時　←こんな感じで20項目 Set adoRS = adoCON.Execute("select * from sample1.csv where (ID = 213428) or (ID = 212717) or (ID = 212917)") 'SQLの実行結果をデータが無くなるまでrecへ格納します Do Until adoRS.EOF = True rec = rec & adoRS("ID") & "," & adoRS("名前") & "," & adoRS("長文１") & "," & adoRS("長文２") & Chr(10) 'カーソルを次の行へ adoRS.MoveNext Loop 'recの内容をイミディエイトウィンドウへ表示 Debug.Print rec 'recの内容を出力 Write #1, rec 'CSVファイルをクローズします Close #1 'レコードセットをクローズします adoRS.Close 'データベースのクローズ adoCON.Close

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する