| |
▼ichinose さん：
こんばんは、お久しぶりです。
このマクロに興味があったので、実例で試してみたのですが
mainの
flnm = Application.GetOpenFilename("追加したいＤＢ,(*.mdb)")
のところで処理が進まなくなってしまいます。すなわち、適当なDB名を入力して「開く」をクリックあるいは「×」をクリックしても前へ進みません。ちなみに
このステートメントの直後に
MsgBox flnm
を挿入してflnmの値を見ますとFALSEとなっています。
そうだとすれば、Accessへの書き込み処理はされなく処理停止となってなってしまうのはやむを得ないですね。どこに問題があるのでしょうか？教えて下さい。
私のプラットホームは
Windows XP Pro & Office XP Pro
です。
>>'==============================================================
>>Function put_rs(rng As Range) As Long
>>'データのセット
>>'input : rng : 書き込みセル範囲
>>'output: put_rs リターンコード 0正常 その他:異常
>> On Error Resume Next
>> With rs
>> .AddNew
>> For idx = 1 To rng.Count
>> .Fields(idx - 1).Value = rng.Cells(idx).Value
>> Next idx
>> .Update
>> End With
>> On Error GoTo 0
>>End Function
>↑を以下に訂正
>'===================================================================
>Function put_rs(rng As Range) As Long
> On Error GoTo err_put_rs
> put_rs = 0
> With rs
> .AddNew
> For idx = 1 To rng.Count
> .Fields(idx - 1).Value = rng.Cells(idx).Value
> Next idx
> .Update
> End With
>ret_put_rs:
> On Error GoTo 0
> Exit Function
>err_put_rs:
> put_rs = Err.Number
> MsgBox Error(Err.Number)
> Resume ret_put_rs
>End Function
>
>
>>もうひとつの方法は、tamago さんがおっしゃっていたオートフィルタを使いました。
>>
>>'=======================================================================
>>Sub main2()
>> Dim c_db As String
>> Dim rng As Range
>> Dim crng As Range
>> Set rng = get_match_rng("=○") 'オートフィルタで条件に合うセル範囲の取得
>> If rng Is Nothing Then Exit Sub
>> flnm = Application.GetOpenFilename("追加したいＤＢ,(*.mdb)")
>> If flnm <> False Then
>> c_db = flnm
>> If open_db(c_db) = 0 Then
>> If open_rs("ganyu") = 0 Then
>> For Each crng In rng
>> If put_rs(crng.Resize(, 10)) <> 0 Then
>> Stop
>> End If
>> Next
> call close_rs '←これ入れといて下さい
>> End If
>> MsgBox "データ追加成功"
>> close_db
>> End If
>> End If
>>End Sub
|
|
しん
- 04/7/13(火) 23:07 -
