Microsoft Access 掲示板

返信ありがとうございます。
関係のなさそうなフィールド名を入れてやってみました。
select 見積書送付NO,ファイル名,見積日付　from T_mitu union select  見積書送付NO,ファイル名,見積日付 from T_mitumori;

そうしたら見積日付 from T_mitu の構文エラー　演算子がありませんとでました。書き方が間違っているのでしょうね・・・

T_mitu　　　　　　　　　　　　　　T_mitumori
 見積書送付NO　ｵｰﾄﾅﾝﾊﾞｰ型           見積書送付NO　ｵｰﾄﾅﾝﾊﾞｰ型
 ファイル名　　短いテキスト　　　　　ファイル名　　 短いテキスト　
 見積日付　　　日付/時刻型　　　　　 見積り日付　　 日付/時刻型
 宛先ID　　　　数値型　　　　　　　　会社名　　　　 短いテキスト
 現場ID　　　　数値型 　　　　　　　 氏名　　　　　短いテキスト
 工事名　　　　短いテキスト　　　　　 現場名　　　　 短いテキスト
 金額　　　　　数値型　　　　　　　　 工事名　　　　 短いテキスト
 NET金額　　　数値型　　　           金額　　　　　 数値型
 見積書　　　　添付ファイル　　　　　 NET金額　　　　数値型
                        　　　　　 見積書　　　　 添付ファイル

T_atesaki
  宛先ID　　　ｵｰﾄﾅﾝﾊﾞｰ型　←T_mituの宛先IDとリレーションシップを組んでいる。
  会社名　　　短いテキスト
　氏名　　　　短いテキスト

T_genba
  現場ID　　　ｵｰﾄﾅﾝﾊﾞｰ型　←T_mituの現場IDとリレーションシップを組んでいる
　宛先ID　　　数値型　←T_atesakiの宛先IDとリレーションシップを組んでいる
　現場名　　　短いテキスト

T_mitumoriは過去のデータのためフィールド名は一緒だけど独立しています。
よろしくお願いします。

EXCELLからACCESSに、INSERTでデータを登録するのは、避けた方が良いという事なのでしょうか？

そういうわけではないです。
通常は、問題なくできると思います。
今回はうまくいかないようなので別案を提案してみたまでです。

うまくいかないのは、
adoCn.Execute strSQL 事態に問題があるのではなく、別の部分に原因があるのではと、私は疑ってます。
原因を決めつけないで、もう一度、コード全体を見直してみてはどうでしょうか。

ただ、自分がするなら、最終的にAccessに格納するなら、最初から Access でウェブスクレイピングでして、テーブルに格納します。その方がシンプルだしトラブルもすくないと思います。

DoCmd.FindRecord は名前の通り該当するレコードを検索するものです。
フォームのレコードソースに何も設定されていない、つまり、レコードがないということ、ないものを検索することはできません。

フォーム [F_4_1　JANコード検索画面] で、どこから何を検索するつもりなんですか。

バーコードリーダーを使って　B_1　在庫品マスター　を印刷したものを読み込むつもりなので、何にも関連付けていません。

お伺いしておきたいのですが、
EXCELLファイルと、CSVファイルでは、どちらのファイルが取り込みに適しているのでしょうか？

前回の件も含めて、INSERTの処理には、原因不明のエラーが多いです。
EXCELLからACCESSに、INSERTでデータを登録するのは、避けた方が良いという事なのでしょうか？

SQLと、ACCESSは使い始めたばかりで、
初めてのことは、極力避けて通ろうとしがちなのですが、
どうも必要性があるようなので、
DoCmd.TransferSpreadsheetを試してみます。

フォーム [F_4_1　JANコード検索画面] のレコードソースのテーブルはなんでしょうか。

 adoCn.Execute strSQL がエラーを出さずに実行されているのに、追加に失敗するというのはちょっと考えにくいですね。
うーん、実物をみないと難しいかも。

Accessから、DoCmd.TransferSpreadsheet でインポートしたほうがシンプルなコードになるとおもいますが、それではだめですか。

テーブルに「複数値を持つフィールド」があるということですね。
複数値を持つフィールドの作成または削除 - Access

とりあえず「複数値を持つフィールド」を含めないで、ユニオンクエリにした場合はどうなりますか。
（「複数値を持つフィールド」はユニオンクエリには含められないです。）

それで、うまくいかない場合は、
サンプルを作成して確認してみたいので、現状のテーブルのフィールド名とそのデータ型，どれが複数値をもつフィールドなのか、主キー設定を提示してもらえますか。

返信ありがとうございます。
ユニオンクエリの作り方を見て下記のようにやってみました。

SELECT T_mitu.見積書送付NO, T_mitu.[ファイル名], T_mitu.見積日付, T_mitu.宛先ID, 宛先マスタ.会社名, 宛先マスタ.氏名, T_mitu.現場ID, 現場.現場名, T_mitu.工事名, T_mitu.金額, T_mitu.NET金額, T_mitu.見積書
FROM (宛先マスタ INNER JOIN 現場 ON 宛先マスタ.宛先ID = 現場.宛先ID) INNER JOIN T_mitu ON (現場.現場ID = T_mitu.現場ID) AND (宛先マスタ.宛先ID = T_mitu.宛先ID);

 union all

SELECT T_mitumori.見積書送付NO, T_mitumori.[ファイル名], T_mitumori.見積日付, T_mitumori.会社名, T_mitumori.氏名, T_mitumori.現場名, T_mitumori.工事名, T_mitumori.金額, T_mitumori.NET金額, T_mitumori.見積書, *
FROM T_mitumori;

実行を押すと複数値があるものは・・・とエラーがでてしまいました。
フィールド数を揃えようと宛先ID・現場IDを消してみてもダメでした。これはクエリからではなくテーブルの結合なのでしょうか。テーブルでやるとテーブル1のT_mitumori とテーブル2のT_mituはフィールド数・フィールド名が違うのでうまくいきません。そういうことではないのでしょうか。

よし　様

とても分かりやすく教えてくださってありがとうございます！！
早速試してみましたらばっちりでした（嬉)!!
本当に助かりました(T_T)

手っ取り早く、と言うか力業なんですが、replace関数でちまちまと置き換えていくのはどうでしょうか。
ヘボン式の変換表は外務省のサイトにありました。
https://www.ezairyu.mofa.go.jp/passport/hebon.html

フォーム上にコマンドボタンを配置して、コマンドボタンのクリック時イベントに以下のコードを貼り付けて下さい。
(Private Sub から End Sub）の間

コマンドボタンが押されたら、［ローマ字名］テキストボックスの値にヘボン式ローマ字表記が入ると思います。

    '文字列の変数を宣言　　
    Dim strRome As String

    '［ふりがな］テキストボックスの値を変数に代入
    strRome = Me!ふりがな

    'strConv関数を使って、カタカナに変換
    strRome = StrConv(strRome, vbKatakana)

    'Replace関数を使って、該当する部分を変換
    '拗音を変換
    strRome = Replace(strRome, "キャ", "KYA")
    strRome = Replace(strRome, "キュ", "KYU")
    strRome = Replace(strRome, "キョ", "KYO")
    '※一部省略

    '濁音、半濁音を変換
    strRome = Replace(strRome, "ガ", "GA")
    strRome = Replace(strRome, "ギ", "GI")
    strRome = Replace(strRome, "グ", "GU")
    strRome = Replace(strRome, "ゲ", "GE")
    strRome = Replace(strRome, "ゴ", "GO")
    '※一部省略

    '静音を変換
    strRome = Replace(strRome, "ア", "A")
    strRome = Replace(strRome, "イ", "I")
    strRome = Replace(strRome, "ウ", "U")
    strRome = Replace(strRome, "エ", "E")
    strRome = Replace(strRome, "オ", "O")
    '※一部省略

    '［ローマ字］テキストボックスに値を書き込む
    Me!ローマ字 = strRome

検索フォームに入力をしたら2つのテーブルデータから1つの表に表示できればうれしいです

ユニオンクエリを使うことになります。WEB検索すると解説ページが見つかりますのでそれを参考に作成してみてください。

ユニオンクエリの作り方 | Accessの使い方教えます！（初心者向け）

作成できたら、このユニオンクエリをフォームのレコードソースにすればOKです。

返信ありがとうございます。
検索フォームに入力をしたら2つのテーブルデータから1つの表に表示できればうれしいです

２つのテーブルの検索結果をどのように表示したいのでしょうか。

現状は２つのフォームに表示されているようですが、それを一つのフォームで表示したいということでしょうか。

その場合は、２つのテーブルデータを、一つの表として表示したいのか、２つの表として並べて表示たいのか、
とか、いろいろ表示の仕方がありますが、どのような表示がご希望でしょうか。

まずは、それを明確にしてください。

貴重な情報ありがとうございます。

参考にさせていただきます。

なぜ、他のモジュールから呼び出せるPublicなのか、
分からないので調べてみます。

それに関しては、深い意味はないです。他から呼び出す必要がないなら、Private で問題ないです。

というか、AdoOpen AddDB を汎用化して、他で使いまわすなら、こちらの方を標準モジュールでPublicにしておいた方がいいですね。

なんとなく、でも確実にわかってきました。
If AddDB(Tn, Fn, Fd, adoCn) なんですね。
ありがとうございます。

なぜ、他のモジュールから呼び出せるPublicなのか、
分からないので調べてみます。

どうしても、謎だったら明日、質問させていただきます。

私のコードの Sub Proc が Sub Data に相当しますので、参考にしてください。

すみません、下の部分が分かりません
下の2つのプロシージャは、Sub Dataから呼び出すことになると思いますが
adoCnは、どう定義して呼び出したらよいのでしょうか？

Sub AdoOpen(FileName As String, adoCn As ADODB.Connection)

Function AddDB(ByVal Tn As String, ByVal Fn As String, ByVal Fd As String, ByRef adoCn As ADODB.Connection) As Boolean

最初の、Function AddDBの中に、Sub Dataのコードを書いて処理すれば
コネクションを1回だけ開いて、連続してアップできますが、
分けた方が、汎用性のあるコードになるので、使えるようにしたいと思います。

ちなみに、

別案として、acDialog でダイアログモードで開いたときに、APIで無理やりサイズ変更可能にする方法もあります。
下記でその方法を使ってますのでご参考に。

拡張ズームボックス関数

Shift+F2 または DoCmd.RunCommand acCmdZoomBox で表示されるズームボックスという機能がありますが、開くときにフォントサイズを指定したい、また、ウィンドウのサイズを変更したい。 標準のズームボックスでは既定値のフォントサイズが小さくて見にくい、あるいは、テキスト量が多いとき見にくい、ということで、このような要望がでることがあると思います。 探してみると T'sWareさんの 汎用ZoomBoxクラス というものが...

fc2

纏めると、方法としては、

1. メインフォーム「ポップアップ」「いいえ」
   子フォーム、孫フォーム「ポップアップ」「はい」

2. メインフォーム「ポップアップ」「はい」
   子フォーム、孫フォーム「ポップアップ」「はい」、「作業ウィンドウ固定」「はい」

3. メインフォーム「ポップアップ」「はい」
   子フォーム、孫フォーム ダイアログモード(acDialog)で開く、APIでサイズ変更可能にする

のいずれかになると思います。
それぞれ、動作が異なりますので、動作を確認して、最適な方法を選択してください。

「作業ウィンドウ固定」を「はい」ですか。ありがとうございます。

メインフォームのポップアッププロパティも「はい」です。

訂正します。

稀に隠れてしまう場合がありますので、
明示的に前面表示にするコーディングをしたいと思ってきます。

メインフォームの「ボップアップ」は「いいえ」になってますか。

メインフォームの「ボップアップ」を「はい」にしたまま、
子フォームがメインフォームの裏に隠れないようにするには、子フォームの「作業ウィンドウ固定」を「はい」にしてください。

ありがとうございます。

子、孫ファームのポップアッププロパティは、「はい」にしております。

そうしていても、メインフォームの裏にかくれてしまいます。

２．メインフォームから子、孫まで開く可能性があり、開いたフォームを前面に表示したい
　　常に最善面表示にしたい訳ではない

子フォーム、孫フォームの「ポップアップ」プロパティを「はい」に設定するのではだめですか。

コネクションを最初に1回生成してOpenして、
続けて100回追加して、最後にCloseするには、以下のようなプロシージャを作っておいて

AdoOpen() というようにプロシージャを分けるなら、下記のような設計がいいかな。

Sub AdoOpen(FileName As String, adoCn As ADODB.Connection)
    Dim FilePath As String
    FilePath = "C:\Users\tasukaru\Desktop\VBA\出品データ用\access\" & FileName

    Set adoCn = CreateObject("ADODB.Connection") 'ADODBコネクションオブジェクトを作成
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath & ";" 'Accessファイルに接続
End Sub

Function AddDB(ByVal Tn As String, ByVal Fn As String, ByVal Fd As String, ByRef adoCn As ADODB.Connection) As Boolean
    Dim strSQL As String
    AddDB = True
    
    On Error GoTo errTrap
    strSQL = "INSERT " & "INTO " & Tn & Fn & " VALUES" & "(" & Fd & ")"
    'Debug.Print strSQL
    adoCn.Execute strSQL 'SQLを実行して対象を追加
  
    Exit Function
errTrap:
    AddDB = False
    MsgBox Err.Number & ": " & Err.Description
End Function

Public Sub Proc()
    Dim adoCn As ADODB.Connection
    AdoOpen "データ.accdb", adoCn
    
    Tn = "・・・"
    Fn = "・・・"
    Fd = "・・・"
    
    If AddDB(Tn, Fn, Fd, adoCn) = False Then
        MsgBox "データ追加に失敗しました。"
    End If

    adoCn.Close
    Set adoCn = Nothing
End Sub

AddDBでデータ追加に失敗するとエラートラップでエラーメッセージを表示するようにしてますので、
それで失敗の原因が特定できると思います。

コードの詳細をアップするのは、連絡をお待ちしてからにしますが、
シートを変数に、格納してそれを対象にするように変更します。
かなり、改善されるような気がします。

あと、初歩的な質問で申し訳ないのですが、
コネクションを最初に1回生成してOpenして、
続けて100回追加して、最後にCloseするには、以下のようなプロシージャを作っておいて

Sub AdoOpen()
    strFileName = "データ.accdb" 'データベースのファイル名

    Set adoCn = CreateObject("ADODB.Connection") 'ADODBコネクションオブジェクトを作成
    adoCn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\tasukaru\Desktop\VBA\出品データ用\access\" & strFileName & ";" 'Accessファイルに接続
End Sub

　　AdoOpen

    Set ws = ThisWorkbook.Worksheets("出品ファイル")
    Num1 = 1 '回数入力
    Num2 = ws.Cells(i, 6).Value '特価取得
    ・・・

　　adoCn.Close

で、良いのでしょうか？

[初期のデータ追加]フラグを用意して
＜最終行に追加＞＜計算列オートフィル＞
if [初期のデータ追加] then 最初のデータ行目を削除

とかやればワークテーブルも関数の復元もいらないんじゃないですかね

この部分だけでも、かなりの量になりますが、大丈夫でしょうか？
添付ファイルで送れれば、ファイルを送りますが。
見ていただいて、問題個所を公開していただいても構いません。

Worksheets("出品ファイル").Activate
 For i = 2 To nl
で、データを拾っていきます。

この For Next内で DataプロシージャをCallしているということでよすね。
このFor Next内で何をしているか知りたいのです。

というのは、

この過程で、画像をコピーしたり、フォルダを作ったりという作業を並行して行っているので
先走りして、追加が終わらないうちに、次のデータの処理を始めてしまうのが、原因だろうと予想しております。

まずはその予想があっているのかどうか、
VBAはシングルタスクなのでVBAの標準のコマンドならそのようなことは通常はおこらないはず、外部コマンドを使っているか、なにか特別なことをしているのか、
その辺を確認したいのです。

追加に失敗したら、追加されるまで処理を繰り返すというのは対症療法的な解決法です。できれば、根本の原因を特定して、そちらで解決できる方法がないかさぐるのが先決だと考えます。

その解決法がどうしてもないのなら、次善策として対症療法的解決法をとるというようにすべきと考えます。

とりあえず現状のコードで修正したほうかいいと思われるところを指摘しておきます。

    Worksheets("出品ファイル").Activate
    Num1 = 1 '回数入力
    Num2 = Cells(i, 6).Value '特価取得
    ・・・

シートをActivateしてアクティブなシートを対象に処理をしていますが、アクティブシートを前提にするとバグのもとになります。
シートを変数に格納してそれを対象にするか、With ステートメントで明示的に対象シートを指定するほうが確実、安全なコードになります。

    Dim ws As WorkSheet
    Set ws = ThisWorkbook.Worksheets("出品ファイル")
    Num1 = 1 '回数入力
    Num2 = ws.Cells(i, 6).Value '特価取得
    ・・・

    With ThisWorkbook.Worksheets("出品ファイル")
        Num1 = 1 '回数入力
        Num2 = .Cells(i, 6).Value '特価取得
    ・・・
    End With

次に、下記のコードについて

Function AddDB(ByVal Tn As String, ByVal Fn As String, ByVal Fd As String) As ADODB.Recordset

Functionの戻り値を Recordset にしてますが、INSERT INTO文は Recordset を返しません。テーブルへのデータを追加するだけです。
Function内で戻り値も設定していないので無意味なものになっています。
また、この関数内で、
Set adoCn = CreateObject("ADODB.Connection")
とADODBコネクションを生成してますが、
Closeしてません。使用後は明示的にCloseすべきです。

さらに、100件くらいのレコードを追加する場合、
100回ADODBコネクションを生成することになりますが、
無駄なことです。
100件のレコードを追加するなら、コネクションを最初に1回生成してOpenして、
続けて100回追加して、最後にCloseするという処理にすると効率的です。

いや、違うのです。
販売データを作る、EXCELL VBAの専用エディタがあるのですが、
販売待ちのデータは、excellのシートに保存してあります。

多くても、300件以上になることはありません。
そこで、状況を見ながら数量指定(nl)をして、本番のデータに変換して販売を開始します。

Worksheets("出品ファイル").Activate
 For i = 2 To nl
で、データを拾っていきます。
この過程で、画像をコピーしたり、フォルダを作ったりという作業を並行して行っているので
先走りして、追加が終わらないうちに、次のデータの処理を始めてしまうのが、原因だろうと予想しております。

Declare PtrSafe Function GetInputState Lib "USER32" () As Long
と
SyuppinData (i)
 If GetInputState() Then DoEvents
で、先走りしないようにはしていますが、
経験上、あまり効果は見込めません。

とりあえず、追加の工程は、For iを別口で作って最初に処理するようにはしました。
EXCELLからACCESSは、思っていた以上に負担がかかっているようなので
処理結果を確認して、正しく処理できるまで続けるコードは利用したいと思っております。

提示の Dataプロシージャは1件のレコードを追加するコードですね。
100件のレコードの追加は、Dataプロシージャをループで呼び出しているのだと思いますが、
そのコードも提示してもらえますか。

※質問は編集できますので、質問に追記してください。

連絡が遅くなりすみません。
上記のようにやったらできました。本当にありがとうございました。
伝票ID=1を加えただけでできるとはびっくりです。

このたびはお時間をとらせて申し訳ありませんでした。
おかげさまで完璧でございます。
大変有り難うございました。

Function 許可日 が原因の可能性があります。
下記ように変更してください。

Public Function 許可日(申請日 As Variant) As Variant
    Dim 営業日 As Long
    許可日 = 申請日
    If IsNull(許可日) Then Exit Function 
    Do
        許可日 = 許可日 + 1
        Select Case Weekday(許可日)
        Case vbMonday To vbFriday
            If IsNull(DLookup("祝日名", "T_祝日", "日付=#" & 許可日 & "#")) Then
                営業日 = 営業日 + 1
            End If
        End Select
    Loop Until 営業日 = 2
End Function

活用させて頂いているAutoFontSizeプログラム
Public Sub AutoFontSize(Ctr As Control, IniFontSize As Integer)
    Const MinFontSize = 4 '最小のフォントサイズ
    Const d = 53 'うまく収まらずに改行されてしまう場合はここの数値を増やす
    Dim rpt As Report, Str As String, W As Long
    Dim arStr, i As Integer, H As Long
    Set rpt = CodeContextObject
With rpt
    If Ctr.ControlType = acTextBox Then
      Str = Nz(Ctr.Value, "") 'ここでエラーが出る場合は、Str = Nz(Ctr.Value,"")
    ElseIf Ctr.ControlType = acLabel Then
        Str = Ctr.Caption
    Else
        Exit Sub
    End If
    If Str = "" Then Exit Sub
    .FontName = Ctr.FontName

お世話になります。
AutoFontSizeには大変重宝しており感謝申し上げます。
ところで下記項目を縮小で対応しており
この中で出来日を縮小から外せばクレームはないようです。
当面出来日は縮小から外しても支障はありませんので
外して対応しようかと思います。

Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
AutoFontSize Me.支店名, 10
AutoFontSize Me.販社本部, 10
AutoFontSize Me.備考, 10
AutoFontSize Me.申請者, 10
AutoFontSize Me.支店名, 10
AutoFontSize Me.登録予定日, 10
AutoFontSize Me.出来日, 10
AutoFontSize Me.管轄署, 10
End Sub

出来日は申請日と下記のように関連していますので、このあたりに
関係しているのかなと素人考えではありますが。

でもご教示頂いたもので充分でございますので感謝申し上げます。

Public Function 許可日(申請日 As Date) As Date
    Dim 営業日 As Long
    許可日 = 申請日
    Do
        許可日 = 許可日 + 1
        Select Case Weekday(許可日)
        Case vbMonday To vbFriday
            If IsNull(DLookup("祝日名", "T_祝日", "日付=#" & 許可日 & "#")) Then
                営業日 = 営業日 + 1
            End If
        End Select
    Loop Until 営業日 = 2
End Function

クエリーで　出来日:許可日（[申請日]）

  '新しいブックを追加
  .workbooks.Add

の部分を、下記に変更してください。

  '既存のブックを開く
  .workbooks.Open("既存ブックのファイルパス")