| 
    
     |  | 【14261】で 
 >  ダブルクォーツ無しで出力する事は、こんなコードで出来るけど
 >データの中に、ダブルクォーツや、改行、カンマが有ると、
 >読み込む時に、元の様に成らないよ?
 
 といったのは、ダブルクォーツで括って有れば
 Access等では、データの中に、ダブルクォーツや、
 改行、カンマが有っても1フィールドとして読んでくれるので
 ダブルクォーツで括ら無いのは?
 と言う意味でした
 
 もし、【14261】のコードでCsv出力するなら、以下の様な変更で
 改行を削除できると思います
 
 改修するプロシージャが1つ
 追加するプロシージャが1つです
 
 以下の様に「Function ComposeLine」プロシージャを変更して下さい
 
 
 Private Function ComposeLine(vntField As Variant, _
 Optional strDelim As String = ",") As String
 '  レコード作成
 
 Dim i As Long
 Dim strResult As String
 Dim strField As String
 Dim lngFieldEnd As Long
 Dim vntFieldTmp As Variant
 
 'もし、データが複数なら
 If VarType(vntField) = vbArray + vbVariant Then
 vntFieldTmp = vntField
 Else
 ReDim vntFieldTmp(1 To 1, 1 To 1)
 vntFieldTmp(1, 1) = vntField
 End If
 'データ数の取得
 lngFieldEnd = UBound(vntFieldTmp, 2)
 'データ数繰り返し
 For i = 1 To lngFieldEnd
 strField = PrepareCsvField(vntFieldTmp(1, i))
 '結果変数にフィール文字列を加算
 strResult = strResult & strField
 'データカウントがデータ数未満の場合
 If i < lngFieldEnd Then
 '区切り文字を結果変数に加算
 strResult = strResult & strDelim
 End If
 Next i
 
 ComposeLine = strResult
 
 End Function
 
 以下のプロシージャを追加して下さい
 
 Private Function PrepareCsvField(ByVal vntValue As Variant) As String
 
 ' 改行コードの削除
 
 Dim i As Long
 Dim lngPos As Long
 Dim strSearch As String
 
 'ダブルクォーツで括るか否かの判断処理
 For i = 1 To 2
 strSearch = Choose(i, vbCr, vbLf)
 lngPos = InStr(1, vntValue, _
 strSearch, vbBinaryCompare)
 Do Until lngPos = 0
 vntValue = Left(vntValue, lngPos - 1) _
 & Mid(vntValue, lngPos + 1)
 lngPos = InStr(1, vntValue, _
 strSearch, vbBinaryCompare)
 Loop
 Next i
 
 PrepareCsvField = vntValue
 
 End Function
 
 |  |