VBAエクセルでハイパーリンクをメールに貼りたい方法

このQ&Aのポイント
  • VBAエクセルでメールを送信する際に、文章にハイパーリンクを貼りたい場合、具体的な方法を教えてください。
  • 例えば、OKWAVEというテキストに対して、クリックしたら[http://okwave.jp/]が開くように設定したいです。
  • 既存のコードにどのような修正を加えれば、目的の動作を実現できるのか詳しく教えてください。
回答を見る
  • ベストアンサー

VBA エクセル メール送信 ハイパーリンクの貼り方

お世話になります。 首題の通り、エクセルに記述したマクロを使いメールを送りたいのですが、その際に文章の記述にハイパーリンクを張りたいのです。 例えば下記のモジュールですと、文章のBODYの部分には「OKWAVE」とだけ表示されますが、これをクリックすると[http://okwave.jp/]が開くようにしたいのですが、どのように記述すればよろしいのでしょうか?よろしくご指南くださいませ。 Sub test() Dim strBody As String Filename = "ハイパーリンクの貼り方???" strBody = "OKWAVE" Set myOL = CreateObject("Outlook.Application") Set myMAIL = myOL.CreateItem(0) With myMAIL .to = "123@123.GOM" .Subject = Filename .body = strBody .display '.send End With Set myMAIL = Nothing Set myOL = Nothing End Sub

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 返事が遅くなりしまた。 (1) a) Msg = "<A HREF=;http://google.co.jp/><b>goole検索</b></A>" と b) Msg = "<A HREF=""http://google.co.jp/""><b>goole検索</b></A>" は何が違うんでしょうか? VBAで書く場合は、b)側が正しいです。理由は、VBAでは、素のコードの場合は、String型の変数の中に代入されるので、コードの中では、一個の「"」はエラーが出ると思います。うまく書けているか、Debug.Print でチェックしてみると良いです。リンク先では、b)で書かれていると思います。 (2)は、私は、CSS 自体はインラインで埋め込めば可能だと思います。しかし、フォームまでは書いたことがありませんが、可能・不可能なら、こちらも可能だと思います。ただし、相手側のメールで、セキュリティが働いたら、意味がありません。メールのマナーとしては、あまり良くないようですから、どこかのウェブサイトに飛ばせて、そこが使うようにしたらいかがですか? HTMLメールの制作時に気をつけたい9つのポイント http://coliss.com/articles/build-websites/operation/work/879.html

TENSAW
質問者

お礼

ありがとうございました。 大変参考になりました。

その他の回答 (1)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.1

こんにちは。 要するに、テキストスタイルではなくて、HTML形式にして、ハイパーリンクのコードを書けばよいと思います。 Outlookのメールを送信するマクロ http://oshiete1.goo.ne.jp/kotaeru.php3?qid=4246579 この質問の方は、連続した質問があります。その中のひとつです。もし、分からなければ、補足してください。

TENSAW
質問者

補足

できました!いつもありがとうございます。 二つ質問させてください。 (1) Msg = "<A HREF=http://google.co.jp/><b>goole検索</b></A>" と Msg = "<A HREF=""http://google.co.jp/""><b>goole検索</b></A>" は何が違うんでしょうか? (2)CSSをメールにアタッチすれば、フォームは制御できるのでしょうか? よろしくお願いいたします。

関連するQ&A

  • 初心者ですが、Excelファイル(AAA.xls)の、A1セルの情報を

    初心者ですが、Excelファイル(AAA.xls)の、A1セルの情報を Outlookの本文に入力したいと思っています。 そこで、下記プログラムを組んだのですが、間違いだらけのようで 起動しません。どなたか教えていただけませんか? Sub メール自動送信() Dim my01App As Outlook.Application Dim mymail As Outlook.MailItem Dim body As String Set my01App = CreateObject("Outlook.Application") Set tgtdb = CreateObject("Excel.Application") Set mymail = my01App.CreateItem(olMailItem) With mymail mymail.body = "C:\Users\tomohide\Desktop\AAAA.xls".cells(1,1) End With mymail.Display End Sub

  • ExcelからMailをしたとき漢字が出ない

    Excel上にあるセルの内容をメールにて送りたくて次のようなマクロでメールしたときに本文(.body)の文字が英数は出るのですが漢字が出ません どこを直せばよいか教えてください Sub Mail_01() Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = Sheets("MAIN").Range("U32") ’アドレスの入力 .CC = "" .BCC = "" .Subject = Sheets("MAIN").Range("U33") ’題目の入力 .Body = Sheets("MAIN").Range("U34") '.Attachments.Add ActiveWorkbook.FullName .Send End With Set OutMail = Nothing Set OutApp = Nothing 'Application.Quit End Sub それと.sendでダイアログが現れます。これを出なくしてプログラムを続けたいのですかどうすれば良いのでしょうか 2点よろしくお願いします

  • Excel VBA Outlook送信済メール削除

    お世話になります。 現在、Excel VBA(Excel2010)で、Outlook2010を立ち上げて、添付のExcelの表のE列【GL承認日】に日付を入れると、日付書式を確認して、メールが送信されるVBAを作成しています。 そこで、下記のVBAの下の方にある「myMail.Send」でメールが送信されるようになっていて、メールが送信された後、Outlookの【送信済みフォルダ】に送信済みメールが入ります。 その送信済みメールを【送信済みフォルダ】に入ったら、完全に削除するようにしたいのですが、どのようにVBAを追加すれば宜しいでしょうか? ご存知の方、是非ご教示宜しくお願い致します。 ↓該当のExcel VBAです。 ---------------------------------------------------- Private Sub Worksheet_Change(ByVal Target As Range) Dim myOL As Object Dim myMail As Object Dim myBody As String Dim n As Long Dim mDate As Variant On Error Resume Next 'GL承認日の列の日付書式指定 mDate = Array("yyyy/mm/dd") 'GL承認日の該当セルの日付書式を確認 For Each wz In mDate 'GL承認日の該当セルが空白でない場合は以下を処理 If Cells(Target.Row, Target.Column).Value <> "" Then If InStr(Cells(Target.Row, Target.Column).NumberFormatLocal, wz) > 0 Then 'メールアプリケーションをOutlookに指定 Set myOL = GetObject(, "Outlook.Application") On Error GoTo 0 If myOL Is Nothing Then Set myOL = CreateObject("Outlook.Application") myOL.getnamespace("MAPI").GetDefaultfFolder(6).display End If Set myMail = myOL.CreateItem(0) 'B、C行のセル位置を数値で取得 n = Cells(Target.Row, Target.Column).Row 'メール本文 myBody = "振替伝票入力のGL承認が " & Format(Cells(Target.Row, Target.Column).Value, "yyyy/mm/dd") _ & " に完了しました。" & vbNewLine & vbNewLine _ & "●振替伝票No: " & Range("C" & n).Value & vbNewLine & vbNewLine _ & "================================" & vbNewLine _ & " ▲▲部 ××グループ" & vbNewLine _ & "================================" If Range("B" & n).Value = "ooo" Then myMail.to = "ooo@***.co.jp" 'ElseIf Range("B" & n).Value = "qqq" Then ' myMail.To = "qqq@***.co.jp" End If 'メールのタイトル、本文、本文の形式を指定 myMail.Subject = "【振替伝票 GL承認完了通知】" myMail.Body = myBody myMail.BodyFormat = 1 'テキスト形式 'メールを送信 myMail.Send        (↑此処でメールが【送信済みフォルダ】に入りますが、このタイミングで【送信済みフォルダ】に入ったメールを完全削除したいです。) '変数をリセット Set myMail = Nothing Set myOL = Nothing Else Exit Sub End If End If Next Exit Sub End Sub

  • VBAのIF構文について

    VBAでまたわからないところが出てきたので質問させてください。 ActiveWorkbookのworksheet1のa1セルに何か文字列が入っていると仮定して、下記のstrSUB に入る文字列をifで分岐させたいのですが、どのような構文が適していますでしょうか? 下記の内容では、エラーになってしまいます。 識者の方々、よろしくお願いいたします。 ----------------------------------------------------------------- Sub test送信メール作成() Dim oApp As Object Dim objMAIL As Object Dim strSUB As String Dim strBODY As String Set oApp = CreateObject("Outlook.Application") Set objMAIL = oApp.CreateItem(0) strSUB = if ActiveWorkbook.Worksheets(1).range("a1") = "abc" then "aaa" Else "bbb" End If strBODY = "a" & vbCrLf _ & "b" & vbCrLf _ & "c" With objMAIL .To = "aaa@bbb.com" .CC = "ccc@ddd.com" .Subject = strSUB .Body = strBODY .Display End With End Sub

  • マクロで携帯にメール送信

    いつもお世話になっております。 過去に何度か質問をさせていただき、今回のマクロまでたどり着くことが出来ました。 下記の内容にて、作成しました。 ここで、 (1)セルB1にあて先メアドを置いた場合に、メアドを載せる場合 (2)メールを送信する命令で、【myItem.Send】や【SendMail】ではメールが送信されている場合と送信待機の場合がはっせいしております。必ず、送信するまでの命令を、お教えいただきたいです。 PC環境は、XPです。 メールはMicrosoft Office Outlookです。 Sub CreateMail() '参照設定 : Miscosoft Outlook 9.0Object Library Const ShName = "MAIL送信" Const SbjAdd = "b2" Const BodyAdd = "b3:b14" Dim olApp As Outlook.Application Dim objMail As Outlook.MailItem Dim Rng As Range Dim StrBody As String Set olApp = Outlook.Application Set objMail = olApp.CreateItem(olMailItem) For Each Rng In Range(BodyAdd) StrBody = StrBody & Rng.Value & vbLf Next Rng With objMail .Subject = Worksheets(ShName).Range(SbjAdd).Value .Body = StrBody .Display End With End Sub

  • ACCESS CreateObjectを使ったMail送信の添付ファイル名

    ACCESSからOutlookのMailを送信したいと思っています。 ------------------------ Dim myOL As Object Dim myMail As Object Set myOL = CreateObject("Outlook.Application") Set myMail = myOL.CreateItem(0) myMail.SentOnBehalfOfName = "" myMail.To = "" myMail.Cc = "" myMail.BCc = "" myMail.Subject = "" myMail.Attachments.Add ("") myMail.Body = "" myMail.Display ------------------------------ そこで、添付したいファイルのフルパスをフォーム上に入力し、 都度それを上の記述に反映したいと思います。 例)me.添付ファイル名 myMail.Attachments.Add ("& me.添付ファイル名 &") でも myMail.Attachments.Add (" me.添付ファイル名 ") でも エラーになってしまいます。 引き続きいろんなパタンを試してみますが、 お分かりになる方、教えて下さい!! (”や’に弱いんです・・・。)

  • excelマクロですべてのハイパーリンク解除したい

    excel2016で、ワークシート内のハイパーリンクをすべて解除したいと思います。 すべて削除するマクロは Sub Sample()  With ThisWorkbook.Worksheets("Sheet1")   .Hyperlinks.Delete 'ハイパーリンク削除  End With End Sub なのですが、これを解除の命令に変えて Sub Sample()  With ThisWorkbook.Worksheets("Sheet1")  .ClearHyperlinks 'ハイパーリンク解除  .Font.Underline = False '文字のアンダーライン解除  .Font.ColorIndex = xlAutomatic '文字色を自動設定  End With End Sub とするとエラーになってしまいます。 どのようにすれば良いでしょうか?

  • outlookのメールをExcelで作成するマクロ

    outlookのメールをExcelで作成する際の質問です。 以下のマクロを実行すると始めにwordeditorで作成した あいうえおがMSP明朝で入力され、そのあとに住所、氏名、年齢 ハイパーリンクが入力されます。 strMOJIの方で入力したハイパーリンクはちゃんとハイパーリンクとして 反応するのですが、フォントが明朝になりません。 逆にwordeditorのTypeTextにハイパーリンクを貼り付けても文字として処理されてしまい、ハイパーリンクになりません。 フォントを指定して、尚且つハイパーリンクもちゃんとはりつけられるように するにはどうしたらよいでしょうか? Sub test() Dim Ap As Object Dim M As Object Dim strMOJI As String Set Ap = CreateObject("outlook.application") Set M = Ap.CreateItem(0) strMOJI = vbCr & "住所:" & vbCr & "氏名:" & vbCr & "年齢:" & vbCr & _ "<file://>" M.BodyFormat = 2 M.To = "aaa@com" M.cc = "bbb@com" M.importance = 2 M.Subject = "test" M.Body = strMOJI M.display '#全部ワードで編集した方が分かりやすい? With Ap.ActiveInspector.wordeditor.Windows(1) With .Selection .Font.Name = "MS P明朝" .TypeText "あいうえお" End With End With Application.CutCopyMode = False End Sub

  • エクセルVBAでメール本文中に画像を挿入する方法

    エクセルVBAを使ってアウトルックメールにてメール送信するマクロを作っています。 本文中に画像を挿入する方法をググってますがなかなか出てきません。添付ファイルではなく、本文と本文の間に画像を差し込むイメージです。 メール送信先、本文は同じエクセルのContentsシート、画像はPictシートに格納しています。 Option Explicit Sub SendMail_HTML() Dim contents As Worksheet Dim maillist As Worksheet Dim mailaddress As String, honbun1 As String, honbun2 As String, mailbody As String, strstyle As String Dim i As Long Set contents = ThisWorkbook.Worksheets("Contents") Set maillist = ThisWorkbook.Worksheets("List") ' Picture Dim pict_sheet As Worksheet Set pict_sheet = ThisWorkbook.Worksheets("pict_sheet") 'プログラム3|Outlookアプリケーションを起動 Dim outlookObj As Outlook.Application Dim myMail As Outlook.MailItem Set outlookObj = CreateObject("Outlook.Application") For i = 2 To 3 ' Email and name setting from Content Sheet client_name = maillist.Range("B" & i).Value mailaddress = maillist.Range("C" & i).Value Set myMail = outlookObj.CreateItem(olMailItem) 'Mail content setting myMail.BodyFormat = 2 myMail.To = mailaddress myMail.Subject = contents.Range("B3").Value honbun1 = Replace(contents.Range("B6").Value, vbLf, "<br>") Dim insp As Outlook.Inspector Set insp = myMail.GetInspector If insp.EditorType = olEditorWord Then Dim doc As Word.Document 'Microsoft Wordを参照 Set doc = insp.WordEditor Dim wrange As Word.Range Set wrange = doc.Range(0, 0) 'カーソルを先頭に 'wrange.Text = honbun1 wrange.MoveEnd Word.WdUnits.wdStory 'カーソルを最後に wrange.Start = wrange.End pict_sheet.Shapes("pict1").Copy 'Pict sheetに入っているpict1を指定 wrange.Paste End If honbun2 = Replace(contents.Range("B8").Value, vbLf, "<br>") myMail.HTMLBody = honbun1 & hoonbun2 myMail.Display 'Send mail 'mymail.Display 'メール表示(ここでは誤送信を防ぐために表示だけにして、メール送信はしない) myMail.Save '下書き保存 myMail.Send maillist.Range("D" & i).Value = "Sent:" & Now() ' Release object Set myMail = Nothing Next 'プログラム12|オブジェクト解放 Set myMail = Nothing Set outlookObj = Nothing End Sub

  • VBAのハイパーリンクにつきまして

    以前に質問をさせていただき、こちらでベストアンサーを決定した後に急きょ変更があったところがあり、わからなくなってしまいこちらに戻ってきた次第です。 http://okwave.jp/qa/q8743521.html にて質問をさせていただきました内容について、以下のVBAで解決できております。 しかし、抽出したファイル名にハイパーリンクが欲しいという要望を受けてしまいました。 ハイパーリンクのVBAについていろいろ調べましたが、この記述方法に追加して実行する方法が全く分かりませんでした。 お分かりになる方がいましたら、この内容にハイパーリンクをつける方法をお教えいただけますでしょうか。よろしくお願いいたします。 Sub Macro1() Dim i As Long Dim myPath As String, Flnm As String ReDim Flnmfp(0) As String Dim WS1 As worksheet Set WS1=ThisWorkbook.sheets("sheet1") myPath="望みのフォルダパスを入力" Call fpFileName(myPath, Flnmfp ) 'フォルダ内のファイル名取得 If Ubound(Flnmfp)=0 Then 'フォルダにファイルが無ければ終了 Exit Sub End if For i =1 to Ubound(Flnmfp) Workbooks.open filename := Flnmfp(i) Flnm=Dir(Flnmfp(i)) With Workbooks(Flnm).sheets("sheet1") WS1.Cells(2, i).value=.Range("G5").value WS1.Cells(3, i).value=.Range("G6").value WS1.Cells(4, i).value=.Range("K7").value WS1.Cells(5, i).value=CStr(.Range("G9").value) & CStr(.Range("N9").value) & CStr(.Range("P9").value) '同じ要領で望みのセルを記入する WS1.Cells(8, i).value=Flnm End with Workbooks(Flnm).close Savechanges:=False Next i End Sub Sub fpFileName(ByVal myPath As String, ByRef Flnmfp() As String) 'サブフォルダも含め全部のxlsファイル名をフルパスで取得する   Dim cnt As Long, buf As String, f As Object   buf = Dir(myPath & "\*.xls")   Do While buf <> ""     cnt = Ubound(Flnmfp) + 1 ReDim Preserve Flnmfp(cnt)     Flnmfp(cnt)= myPath & "\" & buf     buf = Dir()   Loop   With CreateObject("Scripting.FileSystemObject")     For Each f In .GetFolder(myPath).SubFolders       Call fpFileName(f.Path, Flnmfp)     Next f   End With End Sub

専門家に質問してみよう