痔になりやすい生活習慣とは?

現在EXCELVBAでプリンターに出力された納品書を毎日50社ぐらいの顧客に手動FAXにて送っています。
通信費削減のために、ファイルをPDF化してEMAIL送信出来るようにしたいと思っています。
添付するファイルがEXCEL BOOKのままであれば以下のコードで出来るのですが、PDF化するやり方が分かりません。
ActiveWorkbook.SendMail Recipients:="email@*****.co.jp", _
Subject:="test"

10万円程度であれば、Adobe Acrobatなどのソフト購入してでも実現させたいと思っています。
又、ユーザーの操作はメーラーの「送信」ボタンをクリックする程度に留めたいです。

よきアドバイスよろしくお願いいたします。

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

A 回答 (3件)

Wordドキュメント → PDF への変換なら、以前VBのメーリングリストでコードを見たことがあり、それを元に作成した経験があります。

(2003年の8月頃?)

ExcelにもWorkbook.PrintOutメソッドはあり、PrintToFile が引数で指定できますので、同じようなことはできるはずです。(未確認)

参考までに、Word用のコードを単純化したものを抜粋します。

※ 下記は、必要最小限の要素を単純化して示したものです。
このままでは汎用性もなく、使い物にはなりません。

※ インデントは半角スペースに変換のこと。


'****************************************************************
'必要ライブラリ
'
'Microsoft Word 9.0 Object Library   C:\Program Files\Microsoft Office\Office\MSWORD9.OLB
'Acrobat Distiller           C:\Program Files\Adobe\Acrobat 5.0\Distillr\Acrodist.exe
'****************************************************************
'
'エラーコードの定義
Public Const pErrPrinterNotAvailable  As Long = 2212 'プリンタが無効です。

Sub MakePdfSample(ByRef strPrinter As String)
'WordドキュメントのPDF変換
'コードの一部分のみ抜粋。
  Dim objWrdApp      As Object ' Word.Application
  Dim objWrdDoc      As Object ' Word.Document
  Dim objAbDist      As Object ' ACRODISTXLib.PdfDistiller
  Dim strDefaultPrinter  As String
  
  '「Acrobat ・・・」以外のプリンタは使用させない。
  If Left$(strPrinter, Len("Acrobat Distiller")) <> "Acrobat Distiller" Then
    Err.Raise pErrPrinterNotAvailable, _
      , _
      "このプリンタではPDFファイルは出力できません。" _
      & vbCrLf & "Adobe の Acrobat Distiller を選択してください。"
  End If
  
  Set objWrdApp = CreateObject("Word.Application") 'New Word.Application
  Set objAbDist = CreateObject("PdfDistiller.PdfDistiller.1") 'New ACRODISTXLib.PdfDistiller
  
  '通常使用するプリンタの情報を退避。(処理の完了後、または実行時エラー発生時に元に戻す)
  strDefaultPrinter = objWrdApp.ActivePrinter
  
  'objWrdApp.ActivePrinter = "Acrobat Distiller on LPT1:"
  objWrdApp.ActivePrinter = strPrinter
  
  Set objWrdDoc = objWrdApp.Documents.Open("C:\Test.doc")
  
  objWrdDoc.PrintOut _
      Background:=False, _
      PrintToFile:=True, _
      OutputFileName:="C:\Test.ps"
  
  objAbDist.FileToPDF _
      "C:\Test.ps", _
      "C:\Test.pdf", _
      vbNullString
  
  objWrdDoc.Close False
  objWrdApp.ActivePrinter = strDefaultPrinter
  objWrdApp.Quit  
End Sub

Option Explicit

'****************************************************************
'必要ライブラリ
'
'Microsoft ActiveX Data Objects 2.5 Library '他のバージョンでの動作は未確認。(2.1での動作は×)
'Microsoft CDO For Exchange 2000 Library

'****************************************************************
'引数
'
'strPath    添付ファイルのフルパス
'strSmtp    SMTPサーバー  (例 : www.mail.hogehoge.com)
'strFromAddr  送信者アドレス (例 : hogehoge@hogehoge.com)
'strFromName  送信者名    (例 : ××株式会社 〇〇担当)
'strSubject   件名      (例 : 未承諾広告)
'strAddr    送信先アドレス (例 : scott@tiger.com)
'strToName   受信者名    (例 : △△株式会社 ◇◇様)
'strMailBody  メール本文
'strCcAddress  CCアドレス
'strBccAddress BCCアドレス
'****************************************************************

'添付ファイル付きメールの自動送信。
Public Function SendMail( _
            ByRef strPath As String, _
            ByRef strSmtp As String, _
            ByRef strFromAddr As String, _
            ByRef strFromName As String, _
            ByRef strSubject As String, _
            ByRef strAddr As String, _
            ByRef strToName As String, _
            ByRef strCcAddress As String, _
            ByRef strBccAddress As String, _
            ByRef strMailBody As String _
        ) As Boolean
  
  Dim objMessage     As CDO.Message
  Dim objConfiguration  As CDO.Configuration
  Dim objFields      As ADODB.Fields
  
  SendMail = False
  
  ' Configurationオブジェクトを生成
  Set objConfiguration = New CDO.Configuration
  
  ' Filedsオブジェクトを生成
  Set objFields = objConfiguration.Fields
  
  ' フィールド情報を設定
  With objFields
    .Item(cdoSendUsingMethod) = cdoSendUsingPort
    .Item(cdoSMTPServer) = strSmtp
    ' フィールド情報を更新
    .Update
  End With
  
  ' Messageオブジェクトを生成
  Set objMessage = New CDO.Message
  
  ' メッセージ情報を設定
  With objMessage
    Set .Configuration = objConfiguration
    .Subject = strSubject
    .To = """" & strToName & " 様"" <" & strAddr & ">"
    
    If Len(strCcAddress) <> 0 Then .CC = strCcAddress
    If Len(strBccAddress) <> 0 Then .BCC = strBccAddress
    
    '複数アドレス指定の場合、変更の必要あり。
    .From = """" & strFromName & """ <" & strFromAddr & ">"
    .TextBody = strMailBody
    .AddAttachment strPath
    'メールを送信
    .Send
  End With
  
  SendMail = True
  
  Set objMessage = Nothing
End Function
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます。
記載いただいたコードを基になんとか出来そうな感じです。来月の生活費がかかっている(笑)ので頑張ってみます。

お礼日時:2005/05/30 11:07

もうご存知でしょうが


アドビ、低価格PDF作成ソフト「Acrobat 7.0 Elements」が最近発売されています。
http://pc.watch.impress.co.jp/docs/2005/0406/ado …
http://www.amazon.co.jp/exec/obidos/ASIN/B00097C …
’-----
上記ソフトを導入すると、Word/Excelからのワンボタン変換ができるようです。
しかしこの操作(手作業)をエクセルVBAから自動的に行うのは難しいでしょう。それはマイクロソフト社がその気にならないとできないでしょうが、利害対抗関係・特許関係などから実現はむつかしい問題ではないでしょうか(この点自信なし)。
ツールバー(?)ボタンを押す操作を研究してVBAでプログラムで実現しても、ファイル名を与える場面などで行き詰まるとおもいます。
一般にすべてマイクロソフト社のソフトとその他社ソフトの連携という点で難しい問題です。
’----
むしろアドビ社のAcrobatのカタログなどで、エクセルファイルをe-mail送信で便利な機能がないか検討(カスタマーインフォーメーションに聞くとか)してみてはどうでしょう。(手元に量販店で手に入れたAcrobatの宣伝パンフがありますが、それらしい機能は載ってないようですが。またPro版は5万7千円ですが。)
    • good
    • 0
この回答へのお礼

そうですね。EXCELにあるAdobeのワンボタンがクリック出来たらいいなと思っていました。
もうAdobe関係の情報も少し調べてみます。

お礼日時:2005/05/30 11:02

全体はわからないけど、PDF化するだけならAdbeはいらない。

安い「いきなりPDF」とか「瞬間PDF」、フリーの「クセロPDF」で十分できる。
「クセロPDF」はバナー広告がでちゃうのでちょっと向かないとは思うけど、試しにやってみるには十分でしょう。
    • good
    • 0
この回答へのお礼

回答ありがとうございました。
この辺りの低価格のソフトで出来れば、助かります。
クロセPDFにはメール添付機能があるようですね。これで宛先やタイトルVisualBasicから指定が出来ば言うことはないのですが・・・

お礼日時:2005/05/29 08:26

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

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

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

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

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

QEXCEL VBAでメール添付して送信

こんにちは。
EXCEL VBAで
自分のファイルをある宛先にメールで送信したい場合は、
どのようにしたらできますか?
どなたか、わかる方・・・教えてください。
よろしくお願いします。

Aベストアンサー

参考のスレのVBAを必要な部分だけにすると以下になります。
準備
VBエディターのツール 参照設定で
Microsoft Outlook 10.0 Object Library にチェックをいれます。
B3セルに 宛先 メールアドレス
F3セルに CC メールアドレス
C3セルに 件名
D3セルに 本文
G3セルに 添付ファイルのパスとファイル名
入れておいた場合です。

Sub ボタン1_Click()
Dim myOLApp As Object
Dim myDATA As MailItem
Set myOLApp = CreateObject("Outlook.Application")
Set myDATA = myOLApp.CreateItem(olMailItem)
myDATA.To = Range("B3").Value
myDATA.CC = Range("F3").Value
myDATA.Subject = Range("C3").Value
myDATA.Body = Range("D3").Value
myDATA.Attachments.Add Range("G3").Value
myDATA.Send
Set myDATA = Nothing
Set myOLApp = Nothing
End Sub

コピペして使ってみてください。コマンドの意味は先紹介のスレに
説明して有ります。

参考のスレのVBAを必要な部分だけにすると以下になります。
準備
VBエディターのツール 参照設定で
Microsoft Outlook 10.0 Object Library にチェックをいれます。
B3セルに 宛先 メールアドレス
F3セルに CC メールアドレス
C3セルに 件名
D3セルに 本文
G3セルに 添付ファイルのパスとファイル名
入れておいた場合です。

Sub ボタン1_Click()
Dim myOLApp As Object
Dim myDATA As MailItem
Set myOLApp = CreateObject("Outlook.Application")
Set myDATA = myOLApp.CreateItem(olM...続きを読む

QVBAでPDFを保存する

Excel2013です。VBAでPDFで保存するコードを書きたいのですが、通常の名前をつけて保存のように保存先とファイル名をその都度変更できるウィンドウを出したいのですが、どのようにすればいいのでしょうか?保存先とファイル名をあらかじめ指定する方法はネット検索でヒットするのですが、そうでない方法が探せません。

以下は現在のコードです。
Sub PDF保存()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"c:\\xxx.pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub

Aベストアンサー

GetSaveAsFilenameメソッドでできるでしょう。


ファイル指定ダイアログの表示
http://www.officepro.jp/excelvba/book_new/index10.html

QEXCEL VBA メール送信でファイル添付

現在、使用しているVBAを利用したメンバー向け案内メール配信で、ファイルを添付できないかと考えております。
G列に入力したアドレスのファイルを添付して送信できればと思うのですが、ご教授願えませんでしょうか。

現在のVBAは企業名、宛先共に変えられるように下記のような形となっております。
添付ファイルも宛先毎に異なります。

B列:送信先メールアドレス
C列:メール件名
D列:送信先所属名
E列:送信先宛名
F列:メール本文

コマンドボタンで一括配信となっております。

【以下記述】
Sub Mail_Send()

Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim i, LastRow As Integer

' CDOオブジェクト初期設定
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Worksheets("Sheet1").Range("C2").Value
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Worksheets("Sheet1").Range("C3").Value
.Update
End With

' 送信範囲設定
LastRow = Worksheets("Sheet1").Range("B7").End(xlDown).Row

' メール送信ループ
For i = 8 To LastRow

' 送信状況メッセージクリア
Worksheets("Sheet1").Range("F2").Value = ""

' メール本文作成
strbody = Worksheets("Sheet1").Range("D" & i).Value & vbCrLf & " " & _
Worksheets("Sheet1").Range("E" & i).Value & " 様" & vbCrLf & vbCrLf & _
Worksheets("Sheet1").Range("F" & i).Value

' 改行変換(送信環境によってはここの修正が必要かも)
tmpstrbody = Replace(strbody, vbLf, vbCrLf)
strbody = Replace(tmpstrbody, vbCr & vbCrLf, vbCrLf)

' メール送信
With iMsg
Set .Configuration = iConf
.From = Worksheets("Sheet1").Range("C4").Value
.To = Worksheets("Sheet1").Range("B" & i).Value
.BCC = Worksheets("Sheet1").Range("C5").Value
.Subject = Worksheets("Sheet1").Range("C" & i).Value
.TextBody = strbody
.Send
End With

' 送信状況メッセージ更新
Worksheets("Sheet1").Range("F2").Value = Worksheets("Sheet1").Range("B" & i).Value & " まで送信成功!"

' 3秒停止
Application.Wait [ NOW() + "0:00:03" ]

Next i

End Sub

現在、使用しているVBAを利用したメンバー向け案内メール配信で、ファイルを添付できないかと考えております。
G列に入力したアドレスのファイルを添付して送信できればと思うのですが、ご教授願えませんでしょうか。

現在のVBAは企業名、宛先共に変えられるように下記のような形となっております。
添付ファイルも宛先毎に異なります。

B列:送信先メールアドレス
C列:メール件名
D列:送信先所属名
E列:送信先宛名
F列:メール本文

コマンドボタンで一括配信となっております。

【以下記述...続きを読む

Aベストアンサー

確認していませんが、こんな感じで出来たと思います。
・・・
.From = Worksheets("Sheet1").Range("C4").Value
.To = Worksheets("Sheet1").Range("B" & i).Value
.BCC = Worksheets("Sheet1").Range("C5").Value
.Subject = Worksheets("Sheet1").Range("C" & i).Value
.Attachments.Add Worksheets("Sheet1").Range("G" & i).Value'←ここ
.TextBody = strbody
・・・

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Qエクセルでメールの自動送信は可能?

 1枚の書類に担当者がそれぞれ確認内容を記載しながら
仕事を進めています。

 各書類を番号で管理し、それをエクセルの
表で台帳管理しています。

 途中の担当者が急遽他の仕事に時間を
とられるなど仕事に遅れを生じる場合がある
のですが、それらをエクセルの表で管理し
全体の調整に使っています。

 

 エクセルの表には、各作業の開始、終了日が
記載されています。

そこで、質問なんですが・・・

 エクセルに記載した日付から特定の期間(例えば
一週間)たつと、予め登録しておいた
担当者のアドレスに自動的に電子メールが送信
されるようにしたいのです。
 催促のメールの自動送信ということです。

何かいい方法はありますでしょうか?

Aベストアンサー

難しいのは、メール送信でしょうから、
これを参考に作成してみてはいかがでしょうか?

http://homepage1.nifty.com/gak/MSTips/multimail.htm

Qエクセルで、条件に一致した行を別のセルに抜き出す方法

エクセルで、指定した条件に一致するセルを含む行をすべて抜き出す方法が知りたいです。

たとえば、

<A列> <B列> <C列>
7/1 りんご 100円
7/2 ぶどう 200円
7/2 すいか 300円
7/3 みかん 100円

このような表があって、100円を含む行をそのままの形で、
別のセル(同じシート内)に抜き出したいのですが。

7/1 りんご 100円
7/3 みかん 100円

抽出するだけならオートフィルターでもできますが、
抽出結果を自動的に、別の場所に、常に表示させておきたいのです。

初歩的な質問だと思いますが、検索しても分からなかったので、よろしくお願いします。

Aベストアンサー

同じ質問が結構よく出てますが、そんなに初歩的でもありません
別シートのA1セルに「100円」と入力し、そのシートの任意のセルに以下の式を貼り付けて下さい。後は、下方向、右方向にコピー。
日付のセル書式は「日付」形式に再設定してください

=IF(COUNTIF(Sheet1!$C:$C,$A$1)>=ROW(A1),INDEX(Sheet1!A:A,LARGE(INDEX((Sheet1!$C$1:$C$500=$A$1)*ROW(Sheet1!$C$1:$C$500),),COUNTIF(Sheet1!$C:$C,$A$1)-ROW(A1)+1)),"")

データ範囲は500行までとしていますが、必要に応じて変更して下さい

Qエクセル マクロで指定フォルダを開く

エクセルにて
指定フォルダを開く、マクロがあれば教えて頂けないでしょうか。
よろしくお願いいたします。

Aベストアンサー

こんにちは。

こういうものですか?
開くフォルダを変えたいときは targ に与えるパスを変更します。

Sub OpenFolders()
Dim targ As String
targ = "C:\"
Shell "C:\Windows\Explorer.exe " & targ, vbNormalFocus
End Sub

QExel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数ではなく、マクロで処理を希望します。

自分では、部品表の商品番号をコピーして、コード一覧表で検索し、検索結果の右隣のセル(B列のコード)の値を部品表のC列に貼り付ければよいかと思い、書いてみたんですが…

Sub 別ブックから貼り付ける()
  Dim 検索する As Long
Windows("部品表.xls").Activate
検索する = cells(i,2).Value
Windows("コード一覧表.xls").Activate
ActiveWindow.SmallScroll Down:=-3
Selection.AutoFilter Field:=3, Criteria1:="=検索する", Operator:= xlAnd

と、してみたものの、検索しても、その検索結果の隣のセルのコードをどうやって取得すればいいのかが、わかりませんでした。

基本事項は本で学びましたが、呪文のようなコードはよく理解できません。懸命にネットで検索して、訳して理解する努力をしてはいますが。

どうぞよろしくお願いします。

部品表というブックがあります
A列に商品名、B列に商品番号が入力してあります。C列のコードは未入力です。
A列     B列     C列      
商品名  商品番号  コード
モータ  U-1325-L  
ホルダ  R-134256

また、コード一覧表という別のブックには、A列に商品番号と、B列にコードが、何千件も入力されています。

やりたいことは
部品表のC列のコード欄に、コード一覧表ブックから商品番号と一致するコードを貼り付けしたいのです。

部品表は、何百種類もありますので、関数...続きを読む

Aベストアンサー

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks.Open("C:\★★\コード一覧表.xls") '★要変更★
 I = 2
 Do While Range("A" & I).Value <> ""
  ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, xlBook.Worksheets("Sheet1").Range("A2:B65535"), 2, 0)
  I = I + 1
 Loop
 xlBook.Close
 Application.ScreenUpdating = True
 MsgBox ("完了")
End Sub

こんにちは。
とりあえず実用性も踏まえました。
メインの動作はワークシート関数のVLOOKUPをVBA上で使用していますので理解はしやすいかと思います。
また、質問文から察するに「部品表.xls」と「コード一覧表.xls」の両方を開いて処理されていますが「コード一覧表.xls」はプログラム内で開いて閉じているので実行するときは「コード一覧表.xls」は閉じて置いてください。
Option Explicit
Sub Sample()
 Application.ScreenUpdating = False
 Dim I As Long
 Dim xlBook
 Set xlBook = Workbooks....続きを読む

QVBA  PDF ファイル名をセルからつける

ExcelでPDFを出力するときに、たとえばB1のセルに入力されているものを、ファイル名の一部として出力する方法がわかりません。

例えばB1に「資料1」と入力されていた場合で、PDFのファイル名を[TEST資料1.pdf]にしたい場合、下記に何かを足すだけでできますでしょうか?

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"I:\補TEST\TEST.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub

できれば、解説もいただけると助かります。よろしくお願いします。

Aベストアンサー

一例です。
文字列の結合ですから解説は不要ですよね。

"I:\補TEST\TEST" & Range("B1") & ".pdf", Quality:=xlQualityStandard, _

QエクセルのIF関数で、文字が入力されていたならば~

エクセルのIF関数で文字が入力されていたならば~、という論理式を組み立てたいと思っています。

=IF(A1="『どんな文字でも』","",+B1-C1)

A1セルに『どんな文字でも』入っていたならば、空白に。
文字が入っていなければB1セルからC1セルを引く、という状態です。

この『どんな文字でも』の部分に何を入れればいいのか教えてください。

またIF関数以外でも同様のことができれば構いません。

宜しくお願いします。

Aベストアンサー

=IF(ISTEXT(A1),"",B1-C1)

でどうでしょうか?


人気Q&Aランキング