Windows7/付属のFAXでのVBAについて

このQ&Aのポイント
  • Windows7/付属のFAXでのVBAについての質問です。Access2010でVBAを使って請求書をFAXで送信したいと考えています。旧環境の情報を参考にしようとしていますがうまくいきません。同じ環境で成功している方の知見を教えてください。
  • Windows7/付属のFAXでのVBAについての質問です。Access2010でVBAを使って請求書をFAXで送信したいと思っています。しかし、古い環境の情報を参考にしても上手くいきません。同じ環境でうまく動作している方のアドバイスがほしいです。
  • Windows7/付属のFAXでのVBAについての質問です。Access2010でVBAを使って請求書をFAXで送信したいと考えています。古い環境の情報を元に作り変えようとしていますが、思うようにいきません。同じ環境の方からのアドバイスをお願いします。
回答を見る
  • ベストアンサー

Windoes7/付属のFAXでのVBAについて

Windows7・付属のFAX・I-Oデータの外付けモデム テストでFAX送信可能なのは、確認しています。 Access2010でVBAを作ろうとしています。 各業者に請求書をFAXで送信するようなものです。 ネット検索で旧環境(Access2000/FAX)のものを発見して作り変えようとしていたのですが、うまく いかないので、どなたか同環境で現在うまく稼働されている方ご教授いただければと思います。 Option Compare Database Option Explicit 'スナップショット保存用フォルダ Const CON_WorkDir As String = "d:\workfax" 'スナップショット用ファイル名 Const CON_ファイル名 As String = "発注書" Private Sub 送信_Click() '------------------------------------------------------------ ' 送信_Click ' '------------------------------------------------------------ ' On Error GoTo 送信_Click_Err Dim W_FaxServer As FaxServer Dim W_FaxDoc As FaxDoc Dim W_RS As New ADODB.Recordset Dim W_送信要求件数 As Integer, W_送信処理件数 As Integer Dim W_SNPファイル名 As String Dim W_相手先 As String, W_FAX番号 As String Dim W_Ix As Long '送信要求件数の確認 W_送信要求件数 = DCount("*", "送信ヘッダーW") If W_送信要求件数 = 0 Then Beep MsgBox "送信する発注書はありません。", vbOKOnly + vbCritical Exit Sub End If 'スナップショット保存用フォルダをクリア On Error Resume Next Kill CON_WorkDir & "\*.*" ' On Error GoTo 送信_Click_Err 'レコードセット(送信ヘッダー)の準備 W_RS.Open "select * from 送信ヘッダーW order by コード", CurrentProject.Connection, adOpenKeyset, adLockOptimistic '送信処理件数をクリア W_送信処理件数 = 0 Do While Not W_RS.EOF '送信情報を設定 W_送信処理件数 = W_送信処理件数 + 1 W_SNPファイル名 = CON_ファイル名 & Format(W_送信処理件数, "000") & "-" & Format(W_送信要求件数, "000") & _ "_" & W_RS.Fields("コード") & "_" & _ Format(Date, "mmdd") & Format(Time(), "hhnnss") W_相手先 = CON_ファイル名 & Format(W_送信処理件数, "000") & "/" & Format(W_送信要求件数, "000") & " " & _ W_RS.Fields("コード") & ":" & W_RS.Fields("相手先") W_FAX番号 = "" W_Ix = 1 Do While W_Ix <= Len(W_RS.Fields("FAX番号")) If IsNumeric(Mid(W_RS.Fields("FAX番号"), W_Ix, 1)) Then W_FAX番号 = W_FAX番号 & Mid(W_RS.Fields("FAX番号"), W_Ix, 1) End If W_Ix = W_Ix + 1 Loop '画面表示を更新 ' Me.相手先.Caption = W_相手先 ' Me.ガイド.Caption = "処理中 " & Format(W_送信処理件数, "#,##0") & "/" & Format(W_送信要求件数, "#,##0") '相手先1件分のFAX文書をスナップショット形式で出力 Call B発注書_コードSet(W_RS.Fields("コード")) DoCmd.OutputTo acReport, "R_発注書", acFormatPDF, CON_WorkDir & "\" & W_SNPファイル名 & ".pdf", False 'test FAX送信----------------------------------------------------ここから W_FaxServer.Connect CreateObject("WScript.Network").ComputerName 'コンピュータ名’ Set W_FaxDoc = W_FaxServer.Create(CON_WorkDir) W_FaxDoc.RecipientName = "送信者名" W_FaxDoc.SenderTitle = "明細" W_FaxDoc.DisplayName = "明細" W_FaxDoc.FaxNumber = W_FAX番号 W_FaxDoc.Send W_FaxServer.Disconnect W_RS.Fields("リターンコード") = 0 W_RS.Update W_RS.MoveNext Loop 'レコードセット(送信ヘッダー)を閉じる W_RS.Close Set W_RS = Nothing '画面表示を更新 ' Me.相手先.Caption = "" ' Me.ガイド.Caption = "" Beep MsgBox "全てのFAXを送信要求しました。", vbOKOnly + vbInformation '送信_Click_Exit: ' Exit Sub '送信_Click_Err: MsgBox Err.Description ' Resume 送信_Click_Exit End Sub 上記のように組んでみたのですが、Sendでも素通りしてしまい、FAXに行きません。 outputでDドライブには、PDFはできているのですが、 いきずまっています どなたかよろしくおねがいいたします。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

http://answers.microsoft.com/ja-jp/office/forum/office_2010-access/access%E3%81%AEvba%E3%81%A7windows-fax/50033225-7127-4e3a-95ef-cc8a12cea4f5 をベースにしつつ 中川システムさんとこのを参考に作成すればできるかと思います。 試験環境を作れないので、これ以上のアドバイスは出来ませんが 一つお願い事があります。 faxcomの参照設定を外して変数宣言の3行を下記にしても動きますか? 余力がありましたら教えてください。 '要参照設定 faxcom x.x type library (FXSCOM.dll) ' Dim lobjFaxSvr As New FAXCOMLib.FaxServer 'FaxServerオブジェクト ' Dim lobjFaxDoc As New FAXCOMLib.FaxDoc 'FaxDocオブジェクト ' Dim lstrPDFPath As String '送信用PDFファイルフルパス名 '↓ Dim lobjFax As Object '参照設定なしの場合、かも?未確認 Dim lobjFaxSvr As Object Dim lobjFaxDoc As Object Dim lstrPDFPath As String Set lobjFax = CreateObject("FaxComEx.FaxDocument") Set lobjFaxSvr = CreateObject("FaxServer.FaxServer")

muuuug
質問者

お礼

大変ありがとうございます。 一度マイクロソフトのコミュニティーに先に問い合わせてみようと思います。 そちらで解決しなければ再度投稿させていただきます。

muuuug
質問者

補足

notfound404様早々のご回答ありがとうございます。 早速 >Dim lobjFax As Object '参照設定なしの場合、かも?未確認 >Dim lobjFaxSvr As Object >Dim lobjFaxDoc As Object >Dim lstrPDFPath As String >Set lobjFax = CreateObject("FaxComEx.FaxDocument") >Set lobjFaxSvr = CreateObject("FaxServer.FaxServer") を試してみました。(確認faxcom xx type libraryの参照設定をはずしてですよね) 動くことは動きました。ただ最後ののMsgBoxで”オートメーションエラーです。エラーを特定できません” とでてきました。 また、ステップインで1行づつ確認していくと、FaxDoc=Nothingのままになっているのですが、 何か気になります。 同じVBAをWinXP/Access2003の環境(掃出しをスナップショットで)では、動作確認は、できているのですが、WIN7・Access2010の場合"Fax.Send"では情報を送らないのでしょうか? でも参考ULRのかたは、成功しているで、そこでもないのでしょうか? もう少しなにかわかれば教えていただけないでしょうか?  

関連するQ&A

  • Access2010のフィルタープロパティ?

    環境:WIN7(32bit)Access2010 以下にVBAをのせさせていただいておりますが、レポートのプロパティで条件を絞込みして、コード毎に、PDFに出力して、FAX(Windows)送信したいのですが、(ただしPDF出力はこだわっておりません。 Filterの位置が悪いのか、使い方が悪いのか、絞込みができておらず、全データーが出てきてしまっています。 どなたか、教えていただけないでしょうか?   ’ここから印刷関係 On Error Resume Next 'レコードセット(T_工場マスタ)の準備 rs.Open "select*from T_工場名マスタ " + "where 工場コード between'" & Me![開始コード] & "' and '" & Me![終了コード] & "'" & "order by 工場コード", CurrentProject.Connection, adOpenKeyset, adLockOptimistic '送信処理件数をクリア 送信処理件数 = 0 If Not rs.EOF Then Do While Not rs.EOF strWhere = "([工場コード] = '" & rs![工場コード] & "')" & " And ([伝票日付] BETWEEN '" & G_開始西暦 & "' And '" & G_終了西暦 & "')" '送信要求件数の確認 vRet = DCount("*", "Q_工場別明細表", strWhere) ' If vRet = 0 Then ' Beep ' MsgBox "送信するものはありません", vbOKOnly + vbCritical ' Exit Sub ' End If If Val(vRet) <> 0 Then '送信情報を設定 wイメージファイル名 = SFW_Dir & "\売上" & rs.Fields("工場コード").Value & "_" & Format(Date, "mmdd") w相手先 = "売上明細表(" & Trim(rs![工場名]) & ")" wFAX番号 = "" wFAX_N = 1 Do While wFAX_N <= Len(rs.Fields("FAX番号")) If IsNumeric(Mid(rs.Fields("FAX番号"), wFAX_N, 1)) Then wFAX番号 = wFAX番号 & Mid(rs.Fields("FAX番号"), wFAX_N, 1) End If wFAX_N = wFAX_N + 1 Loop '相手先1件分のFAX文書を・・・・ With R_工場別明細表FAX    .Filter = strWhere       ←ここで絞り込み(工場コード毎) でもFilter機能していない?strWhereには1件目のコードと日付範囲がちゃんとセットされている .FilterOn = True End With DoCmd.OutputTo acReport, "R_工場別明細表FAX", acFormatPDF, wイメージファイル名 & ".PDF", False Set W_FaxServer = CreateObject("FaxServer.FaxServer") W_FaxServer.Connect CreateObject("WScript.Network").ComputerName Set W_FaxDoc = W_FaxServer.CreateDocument("FaxDocument") W_FaxDoc.FileName = wイメージファイル名 & ".PDF" W_FaxDoc.FaxNumber = wFAX番号 ' Call W_FaxDoc.Send Call W_FaxServer.Disconnect Set W_FaxServer = Nothing Me!FilterOn = False Me!FilterOnLoad = False strWhere = "" R_工場別明細表FAX.Filter = "" '------Faxの送信を要求------------------------------------------------ここまで rs.Fields("リターンコード").Value = 0 rs.Update Else rs.Fields("リターンコード").Value = "無" & "/" & Format(Date, "mmdd") & "_" & Format(Time(), "hhnnss") rs.Update End If DoCmd.Close acReport, "R_工場別明細表FAX" rs.MoveNext Loop 'レコードセット(送信ヘッダー)を閉じる Else MsgBox "工場データが見つかりません!", 48, "管理システム" End If rs.Close Set rs = Nothing MsgBox "全てのFAX送信指示は通信マネージャに渡りました。", vbOKOnly + vbInformation 'CSVへ送信履歴を出力させる DoCmd.TransferText acExportDelim, , "T_工場名マスタ", "d:\****\売上" & "/" & Format(Date, "mmdd") & "_" & Format(Time(), "hhnnss") & ".csv", True Exit_Func6Push: Exit Sub Err_Func6Push: Resume Exit_Func6Push End Sub

  • Excel-VBAでMySQのレコード件数を得たい

    Excel-VBAでレンタルサーバーにあるMySQLのテーブルのレコード件数を得たいのですが、うまくいきません。 色々と調べて下記のようなコードにしたのですが、結果「-1」と表示されます。 レコードは1500件ほどあります。 Excel-VBAからテーブルにレコードを挿入したり、Excel-VBAにレコードをもってきたりはできますので、アクセス自体は問題ないと思います。 どうにも分からず困ってます、どなたか教えてください。 環境としては、Excel2000 WindowsXP MySQL5 ver5.xx です。 Sub testxx() Dim con As ADODB.Connection Dim rs As ADODB.Recordset Dim connectionString As String Dim kensu As Integer connectionString = "Driver={MySQL ODBC 5.1 DRIVER};" _ & " SERVER=xxxx.xxxx.jp;" _ & " DATABASE=xxxDB;" _ & " USER=xxxuser;" _ & " PASSWORD=xxxpass;" Set con = New ADODB.Connection con.Open connectionString sqlStr = "select * from LinkTable" Set rs = con.Execute(sqlStr) 'kensu:件数----------- kensu = rs.RecordCount MsgBox (kensu) 'kensu:件数----------- con.Close End Sub

  • Access VBAで分類別に連番を振る応用

    Sub DAO_num()   '分類別連番付加 Dim db As DAO.Database Dim rs As DAO.Recordset Dim fld As DAO.Field Dim fldid As String Dim stSQL As String Dim i As Long '入力開始番号の値を格納 Dim i2 As String '前ゼロ表記の設定値を格納 Dim i3 As String '入力された変数をセーブ Dim recut As Long '連番付加処理カウンタ stSQL = "SELECT * FROM [Vba] ORDER BY [code] , [zip] , [ID]" Set db = CurrentDb() Set rs = db.OpenRecordset(stSQL, dbOpenDynaset) Set fld = rs.Fields("ren") '[ren]フィールドに連番を付加 rs.MoveFirst i = 0 i2 = "" fldid = rs!code i = InputBox("開始番号を入力して下さい。") i3 = i i2 = InputBox("前ゼロ表記の必要桁数を入力して下さい。") Do Until rs.EOF rs.Edit recut = recut + 1 If fldid <> rs!code Then '[code]が変わったら連番を振り直す i = i3 fldid = rs!code Else End If fld = Format(i, i2) rs.Update i = i + 1 rs.MoveNext Loop rs.Close db.Close MsgBox ("【処理終了】" & vbCrLf & "処理件数= " & recut & " 件") End Sub ---------------------------------------------------------------- 質問です。 i = InputBox("開始番号を入力して下さい。") ↑ここで値を入力した後、確認の為のInputBoxを出して値を入力し、最初入力した値と確認用に入力した値が同じなら処理を行う。不正の場合、メッセージを出して強制終了。 という風にカスタマイズしたいのですが、うまくいきません。 どなたかアドバイス宜しくお願い致します。

  • Excel VBA ADOでのCSV取込みについて

    下記は、Excel VBAでADOを使って、CSVデータを取り出すソースです。ソースは、とあるサイトからほぼ丸写しです。 Sub main()   Const DRIVER As String = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ="   Const PROVIDER As String = "Provider=MSDASQL;Extended Properties="""   Dim cn As New ADODB.Connection   Dim rs As New ADODB.Recordset   Dim idx As Integer   Dim strSQL As String   cn.ConnectionString = PROVIDER & DRIVER & "C:\"""   cn.Open   '全件数取得   strSQL = "SELECT * FROM Sample.csv"   'CSVファイルの内容を取得   Set rs = cn.Execute(strSQL)   rs.MoveFirst   Do Until rs.EOF     For idx = 0 To rs.Fields.Count - 1       Debug.Print rs.Fields(idx).Value '←ここ     Next idx     rs.MoveNext   Loop   Set rs = Nothing   cn.Close   Set cn = Nothing End Sub ここで、「'←ここ」と示した行のrs.Fields(idx).Valueって、実際には「001」と書かれた値は、ダブルクォーテーションでも入ってない限りは「1」と変換されちゃいますよね?これをちゃんと、実際の値「001」のまま取得することって出来ないのでしょうか?

  • DAOでフィールドの値を変更する

    MDBファイルにDAOでアクセスし、フィールド(今回の場合Fields(4))の値をTextBox内の値に変更する方法がわかりません。 Dim WS As DAO.Workspace Dim DB As DAO.Database Dim RS As DAO.Recordset 'レコードを特定する処理 RS.Fields(4).Value = TextBox.Text RS.Update どのように直せばいいのでしょうか??

  • オラクルのデータをAccessに追加 無限ループ

    前回、オラクルからデータを取り出し、Accessのテーブルに書き込みを教えて頂き、データ追加は出来たのですが、データ追加時に無限ループが発生しました。 【環境】 Oracle:10g Access:2010 Dim CON As New ADODB.Connection 'Oracle側コネクション Dim RS As ADODB.Recordset 'Oracle側レコードセット Dim SQL As String 'Oracle側SQL文 Dim i As Integer '処理用インクリメント Dim DT As Date '抽出日付変数(日付型) Dim sDT As String '抽出日付変数(テキスト型) Dim RS2 As ADODB.Recordset 'Access側レコードセット ◎現在の状況 Dim CON As New ADODB.Connection Dim RS As ADODB.Recordset Dim SQL As String Dim i As Integer 'DB接続定義 CON.Open "DSN=DNS名;UID=ユーザー名;PWD=パスワード;" 'SQL文 SQL = "SELECT " SQL = SQL & "カラム1," SQL = SQL & "カラム2," SQL = SQL & "カラム3" SQL = SQL & "FROM オラクルテーブル名 " SQL = SQL & "WHERE 抽出条件 " SQL = SQL & "AND 抽出条件" SQL = SQL & "GROUP BY カラム" SET RS = CON.EXCUTE(SQL) ’取得したレコード数表示 MsgBox "オラクル側のレコード数は: " & RS.RecordCount (1)↑↑↑オラクルから、抽出したレコード数表示 rs2.Open "新しいテーブル名", CurrentProject.Connection, adOpenKeyset, adLockOptimistic rs.MoveFirst Do Until rs.EOF rs2.AddNew rs2!カラム1 = rs!カラム1 rs2!カラム2 = rs!カラム2 rs2!カラム3 = rs!カラム3 rs2.Update rs2.Close: Set rs2 = Nothing rs.close: SET RS = Nothing con.close:SET CON=Nothing end sub 上記を実行したところ、いくら待っても処理がおわらず、強制終了をかけた所、新テーブルには、約150万件追加されてました。 (1)でオラクルから抽出した、レコード数を表示させてみた所、-1でした。 ◎疑問点、 -1ってありえない数値だと思うのですが。 ちなみに、オラクル側で同様のSQLを実行させた所、取得件数は48件でした。 上記について、ご存じの方がいらっしゃいましたら、アドバイスお願いいたします。

  • VBA ADOに関して

    お世話になります。 VBAに関して質問があります。 ADOでDBから値を取得する際、 TEXT型の値が全く取れてきません。 どなたか取得方法をご教授下さい。 宜しくお願い致します。 DB:Sybase OS: RedHat 8.0 Dim rs As ADODB.Recordset Dim sql As String sql = "select * from " & tblName //dbはADODB.Connection Set rs = db.Execute(sql) Do While Not rs.EOF //ここでTEXT型だと、取れてきません。  If IsNull(rs.Fields('Field名').Value) Then End If rs.MoveNext Loop

  • ACCESS VBA

    ACCESSで検索フォームを作りたいと思っています。 VBAを使って行きたいと思うのですが、うまくいきません。 希望としては、該当するレコードのデータを抽出したいです。 よろしくお願いいたします。 ※現段階でのソースを書いてみました。 最終的に行いたい処理とは違うのですが、根本的に間違っているようなので簡略化しました。 /------------------------------------------------/ Private Sub コマンド1_Click() Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim sql As String '接続 Set cn = CurrentProject.Connection 'レコードセットを取得 Set rs = New ADODB.Recordset sql = "SELECT * FROM 従業員データ " & _ "WHERE 年齢=30" rs.Open sql, cn, adOpenDynamic, adLockReadOnly rs.Close: Set rs = Nothing cn.Close: Set cn = Nothing End Sub /------------------------------------------------/

  • ACCESS 処理件数の取得

    更新した件数を取ろうとしています。 下記のような処理をしている場合どう値をとればいいのでしょうか? rst.RecodCountでとろうとしたらテーブル内の件数(?)が取れてしまったようなのですが・・・ Dim rst As DAO.Recordset rst.Fields(1) = rstWork.Fields(1) rst.Update

  • ADOによるCSVファイルからのデータ取得

    EXCELVBAを用いて、ADODB.CONNECTIONによりデータを取得しようと思い、ネットで調べた プログラムを使ってみたのですが、途中のレコードまでしか取得できませんでした。 ちなみに、データを取得しようと思っているもとのCSVファイルのサイズは10GB超、レコード数は 800万行程度あります。 これが、数十MB程度のファイルだと問題なかったのですが、レコード数などに制限はあるのでしょうか。 ご教示いただけますと幸いです。 用いたマクロの構文は以下のとおりです。 Dim con As New ADODB.Connection Dim connectionString As String Dim csvFilePath As String Dim rs As ADODB.Recordset Dim colNo As Long Dim fileNumber As Long Dim Buffer As String 'CSVファイルが置かれているフォルダ csvFilePath = E:\ connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=" & csvFilePath & ";" _ & "Extended Properties=""Text;HDR=NO;FMT=Delimited""" 'コネクションオープン con.Open connectionString 'ここでSQL文によりレコードを取得します。 Set rs = con.Execute("SELECT COUNT(*) FROM XXX.CSV") fileNumber = FreeFile Open OutputFolder & Application.PathSeparator & OutputFile For Output As #fileNumber Buffer = "" ’ヘッダーの出力 For colNo = 0 To rs.Fields.Count - 1 If Buffer <> "" Then Buffer = Buffer & "," End If Buffer = Buffer & rs.Fields(colNo).Name Next Print #fileNumber, Buffer ’データの出力 Do While rs.EOF = False Buffer = "" For colNo = 0 To rs.Fields.Count - 1 If Buffer <> "" Then Buffer = Buffer & "," End If Buffer = Buffer & rs.Fields(colNo).Value Next Print #fileNumber, Buffer '次のレコード rs.MoveNext Loop Close #fileNumber 'クローズ con.Close Set rs = Nothing Set con = Nothing End Sub