初めての店舗開業を成功させよう>>

VBA初心者です。
Access VBAで読み込んだ配列をcsvファイルにエクスポートしているのですが、
配列が1列ずつではなく1行ずつエクスポートされてしまいます。
どこが悪いかは大体予想がつくのですが、どうすればいいか分かりません。

また、複数のファイルを読み込んで1つのファイルにエクスポートするため、
いちいち「55:ファイルは既に開かれています」と表示されます。
これもどうにかならないでしょうか?
よろしくお願いします。

Private Sub cmd_Click()
On Error GoTo Err_cmd_Click
Dim strArg() As String
Dim Contents As String
Dim ReadFileName As String
Dim WriteFileName As String
Dim i As Integer
Dim inp As Long
Dim cnt As Integer
Dim temp As String '1行のデータの仮置き

inp = Forms![フォーム1]![日付] 'フォームの非連結テキストボックスと連動


For cnt = 0 To 30
ReadFileName = "P:\dl_engine\logs1\service\" & inp + cnt
' ファイル読込
Open ReadFileName For Input As #1
Do Until EOF(1)
Line Input #1, temp
Contents = Contents & temp & vbCrLf
Loop
Close #1
strArg = Split(Contents, " ") ' スペースで分割

WriteFileName = "C:\Contents\ザ★スクリーン\auDownLoadLog.csv"
' ファイル保存
Open WriteFileName For Output As #2
For i = 0 To UBound(strArg)
Print #2, strArg(i)
Next i
Next cnt

'正常終了
Exit_cmd_Click:
Exit Sub

'エラー処理
Err_cmd_Click:
Beep
Select Case Err.Number
Case Else
MsgBox Err.Number & ":" & Err.Description
End Select
Resume Next
End Sub

このQ&Aに関連する最新のQ&A

A 回答 (3件)

内容を見ると、Access2000以上と思いますが、動かす環境が無いため、机上デバッグです。


LineInputしたtempをSplitしているので、tempがデータの行単位でこれをカンマ表示すると解釈しました。
うまくいけば、Excelに読み込める。これが目的?

Access2000なら、Splitしたら『,』を使ってJoinできなかった?(Excel2000か?)


手を加えてみました。動くかな???(止まったらごめんなさい)

Private Sub cmd_Click()
  On Error GoTo Err_cmd_Click

  Dim strArg() As String
  Dim Contents As String
  Dim ReadFileName As String
  Dim WriteFileName As String
  Dim i As Integer
  Dim inp As Long
  Dim cnt As Integer
  Dim temp As String '1行のデータの仮置き

  inp = Forms![フォーム1]![日付] 'フォームの非連結テキストボックスと連動

  '============ 保存ファイルは1つのように見える。最初に宣言 =========
  WriteFileName = "C:\Contents\ザ★スクリーン\auDownLoadLog.csv"
  '保存ファイルを開く
  Open WriteFileName For Output As #2
  '===================================================================

  For cnt = 0 To 30
    ReadFileName = "P:\dl_engine\logs1\service\" & inp + cnt

    ' ファイル読込
    Open ReadFileName For Input As #1

    Do Until EOF(1)
      Line Input #1, temp

      strArg = Split(temp, " ") ' スペースで分割
      '====== CSVファイルなのでカンマで分けた文字列にする =================
      'CSVなのにカンマがない。カンマを付加する箇所を付けてみた。
      'Access2000? ならJoin関数がある?当方、Access97のためよく分からず
      'tempにスペースがない場合があるのか
      temp = strArg(0)
      For i = 1 To UBound(strArg)
        temp = temp & "," & strArg(i)
      Next i
      '====================================================================
      Contents = Contents & temp & vbCrLf
    Loop
    Close #1

    '========= 1ファイル分のデータを書く ================
    '========= ContentsにvbCrLfがあるので改行しない=======
    Print #2, Contents;
    '========= Contentsをクリア ==========================
    Contents = ""
    '=====================================================
  Next cnt

  '======= ファイルを閉じる ===
  Close
  '============================

'正常終了
Exit_cmd_Click:
  Exit Sub

'エラー処理
Err_cmd_Click:
  Beep
  Select Case Err.Number
    Case Else
      MsgBox Err.Number & ":" & Err.Description
  End Select
  Resume Next
End Sub
    • good
    • 0
この回答へのお礼

さっそく試したところ、一発で動きました。
大変たすかりました。一昨日からVBAと格闘してまして、
頭を悩ませており、ここでお世話になってます。
本当にありがとうございました!

お礼日時:2002/04/04 15:52

こんにちは。

maruru01です。

質問文からすると、30個のCSVファイルの内容を1つのファイル(WriteFileName)に読み込むということでしょうか。
その場合、最初の30個のファイルの構成はどうなっていて、それをどのような構成でWriteFileNameに書き出すのでしょうか。
最初の30個のファイルの各行を、そのままWriteFileNameに1行ずつ書き出すのでしょうか。それとも1行の中のカンマで区切られたいくつかのデータを、WriteFileNameでは1行ずつばらして書き出したいのでしょうか。
また、30個のファイルのデータは順番につなげて書き出すのでしょうか。
質問の方法だと、Contentsにファイルの内容をそのまま、まるごと書き出します。(カンマとかダブルクォーテーションもそのまま)
したがって、Contentsを配列変数にして、Contents(0)からContents(29)までをつなげて(AllContentsとする)、書き出すファイルに一度に
Print #2, AllContents
とすれば、30個のファイルをそのまま縦につなげた形になります。

それからエラーの件ですか、cntのForループの中に
Open WriteFileName For Output As #2
という文があるのが原因ですので、Forループの外(一番前)でOpenし、Forループの外(一番後ろ)でCloseして下さい。

なお、このエラーはファイル番号2がすでに開かれているのに、また開こうとしたためのエラーで、このようなことが起こらないように、FreeFile関数でファイル番号を取得します。
FreeFile関数は、使用されていないファイル番号を自動的に探して返す関数で、使い方は、

Dim fileNum As Integer

fileNum = FreeFile
Open WriteFileName For Output As #fileNum

という感じです。
ただし、今回の場合はおそらくOutPut用のファイルは1つ開くだけでしょうが。
補足をお願いします。
では。

この回答への補足

うまく質問が出来ていませんで申し訳ないです。
また、よろしくお願いします。

> 質問文からすると、30個のCSVファイルの内容を1つのファイル(WriteFileName)に読み込むということでしょうか。
そうです、20020301~20020331というファイルを読み込みます。

> 1行の中のカンマで区切られたいくつかのデータを、WriteFileNameでは1行ずつばらして書き出したいのでしょうか。
また、30個のファイルのデータは順番につなげて書き出すのでしょうか。
30個のファイルの1行のなかの半角スペースで区切られたデータをばらして
ファイルの順番通りに出力したいのです。
1行の中身がABCとすると、現状では
A
B
C
とこれの繰り返しとなっています。
これをA B C(各セル)に出力したいのですが。
よろしくお願いします。

補足日時:2002/04/04 13:56
    • good
    • 0

>Print #2, strArg(i)


のところを、
Print #2, strArg(i);
         ↑セミコロン
(行送りは「Print #2,」で)にするか、
strTmp = strArg(i) & strArg(i+1) & ...(なんたら)
と、一旦、1行分の文字列にしてから書き込んだり・・・
で、解決するとは思いますが、

CSVって、結構いろいろあるので、AccessVBAならテンポラリのテーブルをつくって、そいつをエクスポートしてやると、あとあと便利ですよ。

まぁ、どうするかは、臨機応変に・・・

この回答への補足

うまく質問ができていませんでした。
これだと配列が1行分にされてしまいます。
一旦、1行のものを配列に分割にしているので、現状ですと
A
B
C
というふうに配列が1行ごとに出力されてしまいます。
そうではなく、
ABC・・・というふうに各列ごとに出力したいのです。
よろしくお願いします。

補足日時:2002/04/04 12:52
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q2次元配列のデータをファイルへ保存

教えて下さい。
a(100,200)の2次元配列のデータをファイルに保存したいのですが、
a(0,0),a(0,1),a(0,2).......a(0,200)
a(1,0).......
a(2,0)...
.
.
.
a(100,0)...................a(100,200)
といった感じでカンマ区切りでCSV形式で保存したいのですが、これを簡単にファイルに保存する方法を
教えて下さい。
よろしくお願いします。

Aベストアンサー

; をつけないと改行されてしまうようです。

for i=0 to 100
for k=0 to 199
write #1,a(i,k);
next k
write #1,a(i,200)
next i

これでどうでしょうか?

QAccessでSQL結果を直接csvに書き出すには?

Access2003,WinXP

お世話になります。
自作のSQLを書いて、結果をTransferTextで手軽にCSVにできないかと考えてこんなのを書いてました。
Dim strSql AS String
Dim strPath AS String
strSql = 自作SQL文
strPath = c:\test.csv
Docmd.TransferText acExportDelim, , strSql, strPath, True

しかし、TransferTextでは「テーブル」か「クエリ」名を直接書くように指示してあり、これだと動かない?んでしょうか。
SQLは300個くらい出力する必要があるため(クエリ300個作れば解決するのですが・・・)上のようなコードをループして動かしたいのですが、何か他の簡単な出力方法があるのでしょうか。
よろしくお願いいたします。

Aベストアンサー

Dim dbs As Database
Dim qdf As QueryDef
Dim strSql AS String
Dim strPath AS String
Dim i As Integer
Set dbs = CurrentDB
'準備。「適当なクエリ名」と言うクエリを作る
qdf = dbs.CreateQueryDef("適当なクエリ名","SELECT * FROM 何か適当なテーブル");
Set qdf = Nothing 'qdfを開放
'ループ
For i = 1 to 300
  strPath = "c:\test" & Format(i,"00#") & ".csv"
  strSql = 自作SQL文
  dbs.QueryDefs![適当なクエリ名].SQL = strSql
  Docmd.TransferText acExportDelim, , strSql, strPath, True
Next
dbs.Close 'dbsをクローズ
Set dbs = Nothing 'dbsを開放

Dim dbs As Database
Dim qdf As QueryDef
Dim strSql AS String
Dim strPath AS String
Dim i As Integer
Set dbs = CurrentDB
'準備。「適当なクエリ名」と言うクエリを作る
qdf = dbs.CreateQueryDef("適当なクエリ名","SELECT * FROM 何か適当なテーブル");
Set qdf = Nothing 'qdfを開放
'ループ
For i = 1 to 300
  strPath = "c:\test" & Format(i,"00#") & ".csv"
  strSql = 自作SQL文
  dbs.QueryDefs![適当なクエリ名].SQL = strSql
  Docmd.TransferText acExportDelim, , strS...続きを読む

Q【VBA】ExcelマクロでCSVファイルに保存したデータが""で囲まれてしまう

添付図のような、Excel2003で作成した表内のデータを
CSVで保存するマクロを作成したのですが、
図のように、CSVファイルに「""」で値が囲まれた状態で、
保存されてしまいます。

下記にマクロを記載しますので、
どうすれば文字列が「""」で囲まれずに、
カンマ区切りだけのデータで出力されるのか、
ご存知の方おられましたら、ご教示お願い致します。

Sub csv保存()
Dim フォルダ名 As String
Dim パス名 As String
Dim ファイル名 As String
Dim データ As Variant
Dim 行数 As Long, 列数 As Integer
Dim i As Integer, j As Long, k As Long

ファイル名 = "test.csv"
フォルダ名 = "csv"
パス名 = ActiveWorkbook.Path & "\" & _
フォルダ名

'csvフォルダが存在しなければ作成する
If Dir(パス名, vbDirectory) = "" Then
MkDir パス名
End If
ChDir パス名

Open ファイル名 For Output As #1

For i = 1 To Worksheets.Count
Worksheets(i).Activate
Worksheets(i).Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
行数 = Selection.Rows.Count
列数 = Selection.Columns.Count

For j = 1 To 行数
For k = 1 To 列数 - 1
データ = Selection.Cells(j, k) _
.Value
Write #1, データ;
Next k
Write #1, Selection.Cells(j, 列数) _
.Value
Next j
Next i
Close #1
End Sub

添付図のような、Excel2003で作成した表内のデータを
CSVで保存するマクロを作成したのですが、
図のように、CSVファイルに「""」で値が囲まれた状態で、
保存されてしまいます。

下記にマクロを記載しますので、
どうすれば文字列が「""」で囲まれずに、
カンマ区切りだけのデータで出力されるのか、
ご存知の方おられましたら、ご教示お願い致します。

Sub csv保存()
Dim フォルダ名 As String
Dim パス名 As String
Dim ファイル名 As String
Dim データ As Variant
Dim ...続きを読む

Aベストアンサー

Write # は文字列を""で囲んで出力する仕様になっています。
そのまま出力したければ、Print #を利用すればよろしいかと。
ただし、Printの場合は区切り文字(カンマ)を自動で出力してくれませんので、併せて出力する必要があります。

For j = 1 To 行数
  For k = 1 To 列数 - 1
    データ = Selection.Cells(j, k) .Value
    Print #1, データ; ",";
  Next k
  Print #1, Selection.Cells(j, 列数).Value
Next j

なお、いらぬおせっかいですが、ドライブが複数ある環境下だと、
 ChDir パス名
だけでは必ずしもcvsフォルダ内に、ファイルが作成されるとは限りません。
 Open パス名 & "\" & ファイル名 For Output As #1
のように、フルパスで指定しておいた方が確実かと…

Q作成したレコードセットのCSV出力の方法

test.csv とtest2.csvから作成したレコードセットをtest3.csvに出力したいのですが、
”指定した式は、いずれかの引数とデータ型が対応していません。”
とエラーが帰ってきます。

色々試したのですがうまくいきません、

作成したレコードセットをCSVファイルにエクスポートする方法を教えてください。

Private Sub コマンド6_Click()


Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset

Set CN = New ADODB.Connection

CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\;" & _
"Extended Properties='Text;HDR=YES'"

Set RS = CN.Execute("SELECT * FROM test.csv a LEFT JOIN test2.csv b ON a.tel = b.tel")

DoCmd.TransferText acExportDelim, , RS, "C:\test3.csv", True, ""



Set RS = Nothing
Set CN = Nothing


End Sub

test.csv とtest2.csvから作成したレコードセットをtest3.csvに出力したいのですが、
”指定した式は、いずれかの引数とデータ型が対応していません。”
とエラーが帰ってきます。

色々試したのですがうまくいきません、

作成したレコードセットをCSVファイルにエクスポートする方法を教えてください。

Private Sub コマンド6_Click()


Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset

Set CN = New ADODB.Connection

CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
...続きを読む

Aベストアンサー

#2です

解決されたという解釈で良かったのでしょうか。
(記述を見直しました)(前のものでも一応動くとは思います)

ただ、気がかりなのがCドライブ直下と言う事で・・・・
(私はそこには作らないというだけの話ですが)


「test1.csv」「test2.csv」のありかを、「D:\HOGE」と仮定します。
作成する「test3.csv」の場所を「E:\hogehoge」と仮定します。
「E:\hogehoge\test3.csv」が存在したらエラーとなります。

「D:\HOGE」を★★に、「E:\hogehoge」を☆☆で置換えて記述したとすると
(#2の記述をチョッと変更しています。
変な改行表示されるので、一度メモ帳等にコピー&ペーストして確認ください)


Dim CN As ADODB.Connection
Dim sSql As String

Set CN = New ADODB.Connection

CN.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=★★;" & _
"Extended Properties='Text;HDR=YES'"

sSql = "SELECT * INTO [test3.csv] IN '☆☆'[Text;FMT=Delimited;HDR=YES;IMEX=0;]" _
    & " FROM [test.csv] AS a LEFT JOIN [test2.csv] AS b ON a.tel = b.tel;"

CN.Execute sSql
Set CN = Nothing

※ この辺については、Web上のブログで見たような気が気ます。
(SQLで CSV出力指定記述とか・・・)

※  [test3.csv] の後の IN句の記述について、いろいろ確認を取られたらと思います。

#2です

解決されたという解釈で良かったのでしょうか。
(記述を見直しました)(前のものでも一応動くとは思います)

ただ、気がかりなのがCドライブ直下と言う事で・・・・
(私はそこには作らないというだけの話ですが)


「test1.csv」「test2.csv」のありかを、「D:\HOGE」と仮定します。
作成する「test3.csv」の場所を「E:\hogehoge」と仮定します。
「E:\hogehoge\test3.csv」が存在したらエラーとなります。

「D:\HOGE」を★★に、「E:\hogehoge」を☆☆で置換えて記述したとすると
(#2の記述をチョ...続きを読む

QAccessのDAOでフィールド名を配列に格納して・・・

Access2000のDAOで下記のようなコードで複写元テーブルから複写先テーブルにデータを追加するとします。

Set Rs1 = Db.OpenRecordset("複写元", dbOpenTable)
Set Rs2 = Db.OpenRecordset("複写先", dbOpenTable)

Do Until Rs1.EOF
Rs2.AddNew
Rs2!FL1 = Rs1!名前
Rs2!FL2= Rs1!性別
Rs2!FL3= Rs1!郵便番号
Rs2!FL4= Rs1!住所
   ・
   ・
Rs2! FL50= Rs1! 50番目
Rs2.Update
Rs1.MoveNext
Loop

複写元のフィールドが50フィールドもあると、いちいちRs1!名前とかRs1!性別とか記述するのが大変ですし、ものすごく長いコードになります。そこで、配列にしてやったらどうだろうかとこんなことをしてみましたがだめでした。

Dim I
Dim FieldsName
FieldsName=Array("名前","性別",・・・"50番目")
           ・
           ・
Do Until Rs1.EOF
Rs2.AddNew
For I=0 To 49
Rs2!フィールド(I) = Rs1!FieldsName(I)
Next
Rs2.Update
Rs1.MoveNext
Loop

じゃあTebleDifのTd.Fields().Nameを使って・・・・やっぱり失敗しました。

For I=0 To 49
Rs2!フィールド(I) = Rs1!Td.Fields(I).Name
Next

やりたいこと分かっていただけますでしょうか?要するにフィールド名を配列の様なもので格納しておいて、レコードの追加時に50回ループさせてRS2のフィールドにいれたいのです。何か良い方法は無いでしょうか。

Access2000のDAOで下記のようなコードで複写元テーブルから複写先テーブルにデータを追加するとします。

Set Rs1 = Db.OpenRecordset("複写元", dbOpenTable)
Set Rs2 = Db.OpenRecordset("複写先", dbOpenTable)

Do Until Rs1.EOF
Rs2.AddNew
Rs2!FL1 = Rs1!名前
Rs2!FL2= Rs1!性別
Rs2!FL3= Rs1!郵便番号
Rs2!FL4= Rs1!住所
   ・
   ・
Rs2! FL50= Rs1! 50番目
Rs2.Update
Rs1.MoveNext
Loop

複写元のフィールドが50フィールドもあると、いちいちRs1!名前とかRs1!性別とか記述す...続きを読む

Aベストアンサー

#2です。

一応自分なりにコードを作ってみました。

Dim I As Integer, Db As Database, Rs1 As Recordset, Rs2 As Recordset

Set Db = CurrentDb
Set Rs1 = Db.OpenRecordset("複写元")
Set Rs2 = Db.OpenRecordset("複写先")

Do Until Rs1.EOF
Rs2.AddNew
For I = 0 To 49
Rs2.Fields(I).Value = Rs1.Fields(I).Value
Next
Rs2.Update
Rs1.MoveNext
Loop
Rs2.Close
Rs1.Close
Set Rs2 = Nothing
Set Rs1 = Nothing
Set Db = Nothing

でいいと思います。ただし、前提条件として、テーブル「複写先」を作っていないとできませんが。

ご参考までに。

QAccessのマクロでモジュールを実行させたい。

Access2002を勉強中の初心者です。

AccessでDB1という名前のデータベースを作成し、その中で、モジュール1というモジュールを作成しました。これを実行するマクロを作成したく、次のようにマクロを作成しました。
マクロのデザイン画面でアクションに「プロージャの実行」を選択、プロージャ名入力覧の右側の...のボタンを押して式ビルダ画面を表示、ここの「関数」フォルダを開いてDB1を選択、表示されたモジュール1を貼り付けてOK。
しかし、このマクロを実行すると、次のエラーとなります。「DB1 指定されたDB1が見つけることができない関数名が含まれています」

根本的に方法が間違っているのでしょうか?
アドバイスをよろしくお願いします。

Aベストアンサー

#1です。

ちょっと時間ができたので、Accessのヘルプで、
 "RunCode/プロシージャの実行" アクション
についてのトピックを見てみました。

結論から言うと、基本的な考え方が間違っているみたいです^^;。

「プロシージャの実行」アクションでは、「Function」プロシージャを指定するようです。
Subプロシージャではエラーになります。


つまりご質問の件では、
「Subプロシージャを呼び出すFnctionプロシージャ」をまず書かなけれえばならない。
そして、マクロのアクションでは、あらためてこのFunctionプロシージャを指定しなければいけません。

QDoEvents関数って何?

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そこで「EXCEL VBA パーフェクトマスター」という本を見たら

for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
DoEvents
next i
unload userform1
と入力すれば解決することがわかりました。

しかし「DoEvents」についてあまり詳しく書いていなかったのでDoEvents関数をヘルプで見ると、
「発生したイベントがオペレーティング システムによって処理されるように、プログラムで占有していた制御をオペレーティング システムに渡すフロー制御関数です。」

と書いてあるのですが正直、書いてあることがよくわかりません。

どなたかDoEvents関数について、
もう少しわかりやすく教えていただけませんか。
それから、最初に書いたコードで実行すると
ユーザーフォームの背景が真っ白になってしまう原因も
教えていただけませんか?

よろしくお願いいたします。

こんにちは。

VBAやプログラミングに詳しい皆様に
教えていただきたい質問があります。

cells(1,1)からcells(5000,1)までの値を消去するときに
処理の進行状況を表示するためにuserform上にプログレスバーを表示したいと思います。

そこで下記のようなコードを入力しました。

userform1.show
for i =1 to 5000
cells(i,1)=""
userform1.progressbar1.value=i/5000*100
next i
unload userform1

しかしこれだとuserformの背景が真っ白になってしまい
ラベルの文字も消えてしまいます。
そ...続きを読む

Aベストアンサー

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
    DoEvents
    Cells(i,1) = ""
  Next i
End Sub

Private Sub CommandButton2_Click()
  MsgBox "hoge"
End Sub

っていうフォームのコードがあった場合、
DoEvents を入れることによって、ループ中にユーザーがCommandButton2 を押すことによって CommandButton2 のクリック イベントも動いちゃいます。
CommandButton1 のクリック イベントではループの前に
CommandButton1.Enabled = False
CommandButton2.Enabled = False
を書いてフォーム上の CommandButton を無効にしておき、ループが終わったら
CommandButton1.Enabled = True
CommandButton2.Enabled = True
と書いて CommandButton を有効に戻してください。

これを工夫すれば、CommandButton2 で CommandButton1 のループを途中キャンセルする処理もすることができます。

Private Canceled As Boolean

Private Sub CommandButton1_Click()

  CommandButton2.Enabled = False

  Dim i As Long
  For i = 1 To 50000
    DoEvents

    If Canceled = True Then
      MsgBox "キャンセルしました"
      Exit Sub
    End If

    Cells(i, 1).Value = ""
  Next i
End Sub

Private CommandButton2_Click()
  Canceled = True
End Sub



コードの行頭にあるスペースは見易さのために全角スペースで作成していますので、これをこのままコピペするとエラーになるかもしれません。
コピペするなら行頭の全角スペースを半角スペースに直してください。

簡単に言うと、
OS に制御を渡すってことです。(ヘルプそのまんま)
時間が掛かるループ処理などの場合、ループが終わるまで制御は独占されてしまいます。
ですのでループ中は OS や Excel そのものにも再描画をさせる暇さえ与えません。
途中に DoEvents を入れると制御が OS に渡るので、OS は溜まっていた処理をそこで行うことができます。
結果、フォームの再描画などが行われることになります。

注意点ですが、
Private Sub CommandButton1_Click()
  Dim i As Long

  For i = 1 To 50000
...続きを読む

QAccessのデータをテキストファイルで出力する方法を教えてください。

Accessのデータをテキストファイルで出力する方法を教えてください。

クエリで抽出したデータをテキストファイルに出力したいのですが、下記のような記述では""や,で区切られてしまいます。
DoCmd.TransferText acExportDelim, "", "クエリ名", "出力ファイル.txt"

フィールドごとに改行して出力する方法はないでしょうか?


<クエリ結果>
フィールド1  フィールド2  フィールド3
aaa      bbb      ccc

<出力テキストファイル>
aaa
bbb
ccc

Aベストアンサー

ADO の GetString メソッドを使って直に文字列を作って出力してみてはいかがでしょうか。
(GetStringのヘルプを参照してください)

列間の区切り、および行間の区切りに vbCrLf を指定します。
出来上がった文字列の最終には vbCrLf が付いているので、それを削除した文字列を出力します。


記述例)

Private Sub Sample()
  Dim rs As New ADODB.Recordset
  Dim vTmp As Variant
  Dim ffn As Integer
  Const sQueryName As String = "クエリ名"
  Const sOutputFileName As String = "C:\Hoge\HogeTest.txt" '出力ファイル名

  rs.Open sQueryName, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rs.EOF) Then
    vTmp = rs.GetString(adClipString, , vbCrLf, vbCrLf)
  End If
  rs.Close

  If (Not IsEmpty(vTmp)) Then
    ffn = FreeFile
    Open sOutputFileName For Output As #ffn
    Print #ffn, Left(vTmp, Len(vTmp) - Len(vbCrLf))
    Close #ffn
  End If
End Sub

ADO の GetString メソッドを使って直に文字列を作って出力してみてはいかがでしょうか。
(GetStringのヘルプを参照してください)

列間の区切り、および行間の区切りに vbCrLf を指定します。
出来上がった文字列の最終には vbCrLf が付いているので、それを削除した文字列を出力します。


記述例)

Private Sub Sample()
  Dim rs As New ADODB.Recordset
  Dim vTmp As Variant
  Dim ffn As Integer
  Const sQueryName As String = "クエリ名"
  Const sOutputFileName As String = "C:\Hoge\H...続きを読む

QAccessのマクロでCSVファイルをインポートする

Accessのマクロ・VBAにてCSVファイルを
インポートしたいのですが、うまくいきません。

DoCmd.TransferText acImportDelim, , "C:\Documents and Settings\yoshimi\My Documents\顧客マスタテーブル.csv", False
現在のコードです。

「オブジェクト'0.txt’が見つかりませんでした。
オブジェクトが存在していること、名前やパス名が正しいことを確認
してください。」
とエラーが表示されます。

過去ログを検索し、似たようなものを見つけ同じようにしたつもりです。
http://okweb.jp/kotaeru.php3?q=1691138
(回答のANo.1の定義の保存場所が分からずしていません)

どこがおかしいのか教えていただきたいです・・・

Aベストアンサー

インポート先(保存先)となるテーブルが指定されていないようです。

その分、カンマ(,)が1個少ないなっているために引数がずれて判断され、インポートするファイルが「C:\~顧客マスタテーブル.csv」ではなく、「0.txt」だと判断されているのではないかと思います。
(「False」がファイル名と解釈され(False=0)、テキストファイルと解釈されて拡張子「.txt」をつけてエラー表示された、と)

とりあえず、「Test」テーブルを作成し(フィールドは仮でF1,F2の2つでテキスト型)、「,"C:\~」の前に「,"Test"」を入れて実行してみて下さい。
(csvファイルが3列以上の構成であれば、「テーブル'Test'にはF3フィールドがありません」とのエラーが表示されるようになりると思いますので、適宜F3,F4,・・・と、必要な列数を追加して下さい:定義のかわりです)

QACCESSからEXCELに出力する際、時間がかかる。

よろしくお願いします。

ACCESS VBA を使用して、既存のEXCELファイルにデータを出力しているのですが、すごく時間がかかってしまいます。件数が少ない時はそれほど気にならないのですが。時間短縮する方法を教えてください。


Sub S_ExportExcel_ADO()
Dim CN As ADODB.Connection
Dim rst As ADODB.Recordset
Dim objExcel As Excel.Application
Dim i As Integer
Dim W_SQL As String
On Error GoTo Err_S_ExportExcel_ADO

Set objExcel = New Excel.Application
objExcel.Workbooks.Open ("test.xls")
objExcel.Worksheets("sheet1").Select

Set CN = CurrentProject.Connection
Set rst = New ADODB.Recordset

W_SQL = "SELECT * FROM データ"
rst.Open W_SQL, CN, adOpenKeyset, adLockReadOnly

i = 1
Do Until rst.EOF
objExcel.Cells(i, 4) = Trim("" & rst![データ1])
objExcel.Cells(i, 5) = Trim("" & rst![データ2])
objExcel.Cells(i, 6) = Trim("" & rst![データ3])
objExcel.Cells(i, 7) = Trim("" & rst![データ4])
objExcel.Cells(i, 9) = Trim("" & rst![データ5])
'***省略***
objExcel.Cells(i, 35) = Trim("" & rst![データ15])
objExcel.Cells(i, 36) = Trim("" & rst![データ16])
i = i + 1

rst.MoveNext
Loop


'EXCEL保存
objExcel.ActiveWorkbook.Close
objExcel.Quit
rst.Close
CN.Close

Set rst = Nothing
Set CN = Nothing
Set objExcel = Nothing


End Sub

よろしくお願いします。

ACCESS VBA を使用して、既存のEXCELファイルにデータを出力しているのですが、すごく時間がかかってしまいます。件数が少ない時はそれほど気にならないのですが。時間短縮する方法を教えてください。


Sub S_ExportExcel_ADO()
Dim CN As ADODB.Connection
Dim rst As ADODB.Recordset
Dim objExcel As Excel.Application
Dim i As Integer
Dim W_SQL As String
On Error GoTo Err_S_ExportExcel_ADO

S...続きを読む

Aベストアンサー

履歴です。
#1のtodo36さんの発言
http://okweb.jp/kotaeru.php3?q=475151


人気Q&Aランキング

おすすめ情報