- ベストアンサー
エクセルVBAからNotesでメール送信
- VBAでNotesからメールを送信する際、複数のアドレスを配列変数で指定すると、2人目以降にメールが送信されない問題が発生しています。
- 質問者は、エクセルシートのアドレスリストを配列にし、重複を省いた配列変数を作成して、その変数に入っている複数の宛先にメールを送信するコードを作成しました。
- しかし、複数のアドレスを配列変数に格納してndoc.SendToに渡すことがうまくいきません。質問者は、配列変数をndoc.SendToに渡す方法について教えていただきたいとしています。
- その他（プログラミング・開発）
- 回答数2
- ありがとう数4
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (1)
- yambejp
- ベストアンサー率51% (3827/7415)
よくわかりませんが、メールアドレスを配列ではなくカンマで羅列した 文字列にしてみてはどうでしょうか？ もしくは配列を必要回数ループ処理して、メールするとか？
お礼
回答ありがとうございます。 配列から取り出したものを1つずつ送信することも考えたのですが 送信された人が誰宛に送られているか分かるように どうしても、一斉送信したかったので、悩んでいました。 配列にばかり固執していましたが、文字列というヒントを頂き 配列と文字列の使い分けを再度考えてみました。 なんとか解決にこじつけました。 ありがとうございました。
関連するQ&A
- エクセル 転記ループが上手くいきません
シート２のA列の数値と、シート３のA列の数値が一致したら、シート２のB列の数値をシート３のB列に転記したいです。（実際はもうちょっと複雑ですが・・） 実際はデータ量があるため、処理時間を少なくしたくて、配列に挑戦してみました。 処理は最後まで行くのですが、転記がされません。 どうしてでしょうか？？ どなたか教えてください！！！ Sub sample2() Dim i As Long Dim ii As Long Dim last As Long Dim last2 As Long Dim MyArray1 Dim MyArray2 last = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row last2 = Sheets("sheet3").Cells(Rows.Count, 1).End(xlUp).Row MyArray1 = Sheets("sheet2").Range("A1:B" & last) MyArray2 = Sheets("sheet3").Range("A1:B" & last2) For i = LBound(MyArray1, 1) To UBound(MyArray1, 1) For ii = LBound(MyArray2, 1) To UBound(MyArray2, 1) If MyArray1(i, 1) = MyArray2(ii, 1) Then MyArray2(ii, 2) = MyArray1(i, 2) End If Next Next End Sub
- ベストアンサー
- Excel（エクセル）
- ExcelのVBAのエラーについて
以下のVBAだとファイルの選択画面が出てきて、キャンセルを押して選択をやめると「ファイルが選択されませんでした」と出て、実行時のエラー1004が出てしまいます。 どうにかエラーを出さない方法を考えているのですが、何がだめなのかが分かりません。色々試しましたが上手くいかなくて非常に困っています。VBA初心者ですがよろしくお願いいたします。 Sub 実装図読み込み1_Click() Dim vriFileName As Variant vriFileName = Application.GetOpenFilename( _ FileFilter:="MIcrosoft Excelブック,*.xls,", _ Title:="実装図のファイルを選択", _ MultiSelect:=False) If vriFileName = Falese Then MsgBox "ファイルが選択されませんでした。", _ vbOKOnly + vbExcelamation, "ファイル名の入力チェック" End If Set targetBook = Workbooks.Open(vriFileName) Dim myCnt As Integer Dim myArray myCnt = Worksheets.Count If myCnt >= 1 Then ReDim myArray(myCnt - 1) For i = 1 To myCnt myArray(i - 1) = Worksheets(i).Name Next i Sheets(myArray).Copy After:=ThisWorkbook.Sheets(1) End If targetBook.Close False Application.ScreenUpdating = True Set targetBook = Nothing Set newWorksheet = Nothing End Sub
- ベストアンサー
- その他（プログラミング・開発）
- VBA修正お願いします。
下記のコードの日付の2011の箇所を2010/6/01～2012/4/01といったように月単位での条件にしたいのですが どこをどうやって変えればいいですか？お詳しい方よろしくお願いします。 Sub カウント2012() Dim dic As Object Dim lastRow As Long Dim r As Long Dim key As String Set dic = CreateObject("Scripting.Dictionary") lastRow = Range("A" & Rows.Count).End(xlUp).Row For r = 2 To lastRow If Year(Cells(r, "C").Value) = 2011 Then key = Range("A" & r).Value & Chr(0) & Range("W" & r).Value If Not dic.exists(key) Then 'キー値が無ければ dic.Add key, 1 'キーを追加して、値(個数)を１に Else '既にキー値があれば dic(key) = dic(key) + 1 'そのキーの値(個数)+1 End If End If '★追加 Next '表示 For r = 2 To lastRow key = Range("A" & r).Value & Chr(0) & "1" '探す値はA列注目行の値+"1"(間にchr(0)) Range("FV" & r).Value = dic(key) Next End Sub
- ベストアンサー
- Visual Basic
- VBA 複数のシートをまたいでの連想配列
win7、Excelは2013を使用しています。 添付画像の様に、12シートの合計を連想配列に格納しsheet13に書き出したいのですが、プロシージャーの下から6行目のところで、エラーコード451が出ます。 どの様に変更すれば良いか教えて下さい。 Sub 年間集計() Dim Dic Dim i As Integer Dim j As Integer Dim sh As Worksheet Dim rng As Range Dim buf As String Dim num As Integer Set Dic = CreateObject("Scripting.Dictionary") For Each sh In Worksheets For Each rng In sh.Range("J2", sh.Cells(Rows.Count, 10).End(xlUp)) buf = rng.Value num = rng.Offset(, 1).Value If Not Dic.Exists(buf) Then Dic.Add buf, num Else Dic.Item(buf) = Dic.Item(buf) + num End If Next rng Next sh j = 2 With Worksheets("Sheet13") For i = 0 To Dic.Count - 1 .Cells(j, 1) = Dic.Keys(i) ’エラー箇所 .Cells(j, 2) = Dic.Items(i) j = j + 1 Next i End With End Sub
- ベストアンサー
- Excel（エクセル）
- Excel VBA 入力規則
入力規則を利用して、３つのセルを連携させることを考えていますが、 不適合な値を張り付けらられた場合に拒否をする方法があるのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ad As String Dim ma As Range Dim ma2 As Range Dim r As Range Dim r2 As Range Dim r3 As Range Dim r1 As Range Dim m As Long Dim m2 As Long Application.EnableEvents = False If Target = "" Then Range("F7").Validation.Delete Range("F7") = "" If Target.Address(0, 0) = "B7" Then Range("D7").Validation.Delete Range("D7") = "" End If GoTo EXIT_SUB End If With Worksheets("Sheet1") ad = "A4" Set r = .Range(ad) Set ma = r.MergeArea Set r1 = r.Offset(0, 1) m = Application.Match(Range("B7"), .Range(r1, .Cells(r.Row + ma.Count - 1, r1.Column)), 0) Set r2 = .Cells(r.Row + m - 1, r1.Column) Set ma2 = r2.MergeArea If Target.Address(0, 0) = "B7" Then If ma.MergeCells Then setValiS Target.Offset(0, 2), r2 Range("F7").Validation.Delete Target.Offset(0, 2) = "" Target.Offset(0, 4) = "" Else MsgBox "A列が連結されていません。" End If ElseIf Target.Address(0, 0) = "D7" Then Set r3 = r2.Offset(0, 1) m2 = Application.Match(Target, .Range(r3, .Cells(r2.Row + ma2.Count - 1, r3.Column)), 0) setValiS Target.Offset(0, 2), .Cells(r2.Row + m2 - 1, r3.Column) Target.Offset(0, 2) = "" End If End With EXIT_SUB: Application.EnableEvents = True End Sub Sub setVali2() Dim tc As Range Dim c As Range Set tc = Worksheets("登録").Range("D3") Set c = Worksheets("Sheet1").Range("C3") setValiS tc, c End Sub Sub setValiS(tc As Range, c As Range) Dim ss As String Debug.Print tc.Address, c.Address ss = getChildren(c) If ss > "" Then With tc.Validation .Delete .Add Type:=xlValidateList, Formula1:=getChildren(c) End With End If Worksheets("登録").Activate End Sub Function getChildren(c As Range) Dim c1 As Range Dim ss As String Dim s1 As String Worksheets("Sheet1").Activate ss = "" For Each c1 In c.MergeArea s1 = c1.Offset(0, 1) If s1 <> "" Then ss = ss & "," & s1 Next c1 If ss <> "" Then ss = Mid(ss, 2) Else MsgBox "データがありません！" End If getChildren = ss End Function Sub Outline() Dim CheckRow As Long Dim Moji As String Dim TopRow As Long Dim EndRow As Long With ActiveSheet .Range("A2").ClearOutline .Outline.SummaryRow = xlAbove CheckRow0 = .Range("A" & .Rows.Count).End(xlUp).Row CheckRow = CheckRow0 Do If Moji = "" Then Moji = .Cells(CheckRow, 1).Value EndRow = CheckRow ElseIf yy_mm(CDate(.Cells(CheckRow, 1).Value)) = yy_mm(CDate(Moji)) Then TopRow = CheckRow If TopRow = 1 Then .Rows(TopRow + 1 & ":" & EndRow).Rows.Group Exit Do End If Else .Rows(TopRow + 1 & ":" & EndRow).Rows.Group CheckRow = CheckRow + 1 Moji = "" End If CheckRow = CheckRow - 1 Loop Until CheckRow = 1 .Rows(CheckRow + 1 & ":" & EndRow).Rows.Group .Outline.ShowLevels RowLevels:=1 ExecuteExcel4Macro "SHOW.DETAIL(1," & CheckRow0 & ",TRUE)" End With End Sub Function yy_mm(d As Date) yy_mm = Format(d, "yy/mm") End Function
- 締切済み
- その他（プログラミング・開発）
- Excel2010 VBA 条件色付け
Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない
- ベストアンサー
- Excel（エクセル）
- VBA 連想配列と回数
Widowsは7 Excelは2013を使用しています。 E列のデータの重複しないリストをK列に書きだすところまでは出来たのですが、 同じ商品名が何回出てきたをカウントしたいのですが、 下記の連想配列で一緒に出来るのか、分けて組まないといけないのか、 教えて下さい。 よろしくお願い致します。 '---------------------------- '重複しないリストをK列に書き出す '---------------------------- Dim Dic, i As Long, buf As String, Keys Set Dic = CreateObject("Scripting.Dictionary") For i = 2 To maxRow buf = Cells(i, 5).Value 'E列のセルの値をbufに格納する If Not Dic.Exists(buf) Then '辞書にまだ登録されていなければ Dic.Add buf, buf 'そのセルの値を連想配列に登録する。 End If Next i '出力 Keys = Dic.Keys For i = 0 To Dic.Count - 1 Cells(i + 2, 11) = Keys(i) 'K2から下にリスト作成 Next i Set Dic = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- ExcelのVBAソースコード（一部）の翻訳
ソースコードの一部ですが、開発者が他界し訊けずにおります。 今後自分でもVBAを勉強しますが、お教えいただけますでしょうか。 なお冒頭は Function process_new(m0 As Integer, m As Integer, d As Variant, ans As Double) As Integer Dim a(501), b(501), s(501), r(501) As Double Dim w(501), g(11), xx As Double Dim s1 As Double Dim k(501) As Integer Dim i, j, flg As Integer でスタートしています。 ＝（以下、質問内容）＝＝＝＝ s1 = s(k(0)) * 1.618 flg = 0 For i = m0 To m - 3 If Not i = k(0) Then If s1 > s(i) Then flg = flg + 1 End If End If Next i ＝（以上）＝＝＝＝
- 締切済み
- オフィス系ソフト
- excel vba
ＶＢＡに不慣れなので教えてください。 今下記のプログラム（Ａ１セルで青色以外の文字を消去する）はＡ１セルのみを対象にしているのですが、 (1)セルをＡ１からＡ３までにする。 (2)処理対象をＡ１のある列を対象とするようにしたい。 各々どう手直しすればいいか。 プログラムtest Public Sub test() Dim r As Range Dim i, wk As String Set r = Range("A1") wk = "" For i = 1 To Len(r.Value) Debug.Print r.Characters(i, 1).Font.ColorIndex If r.Characters(i, 1).Font.Color = vbBlue Then wk = wk + r.Characters(i, 1).Text End If Next r.Value = wk r.Characters.Font.Color = vbBlue End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAについて。
エクセルのVBAのことは全く分かりませんが、他人の書いたVBAを使わせてもらい、自動で一定の間隔ごとに私が記録したマクロを動すようにしています。 そこで質問なのですが、午前8時00から、午前2時00まで5分おきに動かしたいのですが、日付が変わると動作しなくなってしまいます。どこが悪いのでしょうか? Option Explicit Dim mcolTask As Collection Sub 実行予約() Dim i As Date Dim strProcName As String Dim datBigin As Date Dim datEnd As Date Dim datInterval As Date Dim datTimeout As Date Dim blnJustTime As Boolean ' Setting------------------------------------------------------- datBigin = TimeValue("08:00:00") ' 開始時刻 datEnd = TimeValue("02:00:00") ' 終了時刻 datInterval = TimeValue("00:05:00") ' 実行間隔(少なくとも数秒以上で） datTimeout = TimeValue("00:02:00") ' 実行待機タイムアウト blnJustTime = True ' datInterval で丸めるか strProcName = "MACRO1" ' 実行するマクロ名 '--------------------------------------------------------------- ' 既に実行予約されているか確認 If mcolTask Is Nothing Then ' 日付シリアル値を加算 datBigin = datBigin + Date datEnd = datEnd + Date ' 終了時刻が開始時刻より小さければ日をまたぐので補正 If datEnd < datBigin Then datEnd = datEnd + 1 ' 現在時刻が既に終了時刻を過ぎている場合 If datEnd < Now() Then MsgBox "終了時刻を過ぎているため予約できません。", vbCritical, "終了" Exit Sub End If ' 現在時刻が開始時刻を過ぎていれば補正 If datBigin < Now() Then ' 開始時刻を datInterval で指定された値で丸めるか If blnJustTime Then datBigin = Application.Floor(Now() + datInterval, datInterval) Else datBigin = Now() + datInterval End If End If ' 初期化 Set mcolTask = New Collection ' メイン部分 For i = datBigin To datEnd Step datInterval ' 後から取り消せるようにコレクションに退避 mcolTask.Add CStr(i) & "," & strProcName ' Application.Ontime で実行予約を行う Application.OnTime EarliestTime:=i, _ Procedure:=strProcName, _ LatestTime:=i + datTimeout, _ Schedule:=True Next i Else MsgBox "既に実行中です", vbInformation End If End Sub
- ベストアンサー
- Visual Basic
- DCP-J557Nのカラー印刷で色合いがおかしい問題が発生しています。特に緑色が青色に変わり、印刷結果にスジが入ってしまいます。お困りの経緯や試したこと、エラーメッセージなども教えてください。
- お使いの環境についてお知らせください。パソコンやスマートフォンのOSはどのバージョンですか？また、どのような接続方法をお使いですか？関連するソフトやアプリも教えてください。
- さらに、電話回線の種類もお知らせください。IP電話を利用していますか？その他の詳細な情報もお伝えいただけると、問題の解決に役立ちます。
お礼
早速回答頂きありがとうございました。 Set Dic = Nothing の後 adrs = Split(adrsarray, ",") として ndoc.SendTo = adrs とすれば、配列に格納したアドレスに一斉送信することができました。 文字列と配列の使い分けができていなかったようです。 ありがとうございました。