Попытка автозаполнения тела письма с помощью VBA со значениями из таблицы, найденной с помощью функции Worksheet_Change - PullRequest
1 голос
/ 17 апреля 2020

Я в основном создаю эту таблицу инвентаризации, и когда количество детали становится меньше количества заказа, автоматически всплывает электронное письмо для отправки на правильные каналы для изменения порядка детали. У меня есть код, правильно определяющий, когда выскакивать по электронной почте, но я не хочу, чтобы электронное письмо правильно заполняло номер детали и информацию о поставщике, но я не могу понять, как заставить его работать. При настройке моей таблицы сначала указывается номер детали, затем описание, затем поставщик, затем количество, а затем номер для повторного заказа. Мой код ниже.

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  Dim xRg As Range

  If Target.Cells.Count > 1 Then Exit Sub

  Set xRg = Intersect(Range("I5:I100"), Target)
  If xRg Is Nothing Then Exit Sub

  If IsNumeric(Target.Value) And Target.Value <= Application.WorksheetFunction.VLookup(Target.Value, Sheets("Inventory List").Range("I5:J52"), 2, False) Then
    Call EmailAdmin(Target.Value)
  End If
End Sub

Sub EmailAdmin(Target)
  Dim xOutApp As Object
  Dim xOutMail As Object
  Dim xMailBody As String

  Set xOutApp = CreateObject("Outlook.Application")
  Set xOutMail = xOutApp.CreateItem(0)
  xMailBody = "Part needs to be reordered" & vbNewLine & vbNewLine & _
    "Part Number: " & vbNewLine & _
    "Description:  " & vbNewLine & _
    "Vendor:  "

On Error Resume Next
  user = Environ("Username ")
  With xOutMail
    .To = "Admin"
    .CC = user + "@gmail.com"
    .BCC = ""
    .Subject = "Equipment/Reagents Needed"

    .Body = xMailBody
    .Display 'or use .Send
  End With
On Error GoTo 0

  Set xOutMail = Nothing
  Set xOutApp = Nothing
End Sub

На рисунке показано, как не отображается подпрограмма EmailAdmin, если пытаются передать аргументы.

enter image description here

1 Ответ

2 голосов
/ 17 апреля 2020

Сохраняйте свои сабвуферы простыми. Email-Sub не должен знать, где находятся данные - поэтому передайте его в качестве аргументов от sub, который знает, где находятся данные ...

Private Sub Worksheet_Change(ByVal Target As Range)
  ...
  Call EmailAdmin(Target.offset(0,1).value,Target.offset(0,2).value,Target.offset(0,2).value)
  ...
End Sub

Sub EmailAdmin(PartNr, Description, Vendor)
  ...
    xMailBody = "Part needs to be reordered" & vbNewLine & vbNewLine & _
    "Part Number: " & PartNr & vbNewLine & _
    "Description:  " & Description & vbNewLine & _
    "Vendor:  " & Vendor
  ...
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...