Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/17.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
excelvba中的IF和语句_Excel_Vba_If Statement_Outlook_Automation - Fatal编程技术网

excelvba中的IF和语句

excelvba中的IF和语句,excel,vba,if-statement,outlook,automation,Excel,Vba,If Statement,Outlook,Automation,我正在尝试自动化Outlook电子邮件,并具有当前代码,但我需要它还具有以下条件:列AF小于或等于7: 电子邮件地址在H列,天数在AF列 -这目前可以正常工作,但会创建所有电子邮件,而不是出于某种原因过滤AF Sub Send_Second_CDQR_Notification() Dim OutApp As Object Dim OutMail As Object Dim rng As Range Dim Ash As Worksheet Dim Cws As Worksheet Dim Rco

我正在尝试自动化Outlook电子邮件,并具有当前代码,但我需要它还具有以下条件:列AF小于或等于7: 电子邮件地址在H列,天数在AF列 -这目前可以正常工作,但会创建所有电子邮件,而不是出于某种原因过滤AF

Sub Send_Second_CDQR_Notification()
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim Ash As Worksheet
Dim Cws As Worksheet
Dim Rcount As Long
Dim Rnum As Long
Dim FilterRange As Range
Dim FieldNum As Integer
Dim NewWB As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


' DECLARE VARIABLES
Dim LR, eError, AppName, fName, lName, FromMail, CCMail, dDate

'Set filter sheet, you can also use Sheets("MySheet")
Set Ash = ActiveSheet

'Set filter range and filter column (column with e-mail addresses)
Set FilterRange = Ash.Range("A1:AF" & Ash.Rows.Count)
FieldNum = 8    'Filter column = H because the filter range start in column A

'Add a worksheet for the unique list and copy the unique list in A1
Set Cws = Worksheets.Add
FilterRange.Columns(FieldNum).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Cws.Range("A1"), _
        CriteriaRange:="", Unique:=True


'Count of the unique values + the header cell
Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))

'If there are unique values start the loop
If Rcount >= 2 Then
    For Rnum = 2 To Rcount

        'If the unique value is a mail address create a mail
        If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" And_
           Cws.Cells(Rnum, 32) <= 7 Then

            'Filter the FilterRange on the FieldNum column
            FilterRange.AutoFilter Field:=FieldNum, _
                                   Criteria1:=Cws.Cells(Rnum, 1).Value

            'Copy the visible data in a new workbook
            With Ash.AutoFilter.Range
                On Error Resume Next
                Set rng = .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
            End With

            Set NewWB = Workbooks.Add(xlWBATWorksheet)

            rng.Copy
            With NewWB.Sheets(1)
                .Cells(1).PasteSpecial Paste:=8
                .Cells(1).PasteSpecial Paste:=xlPasteValues
                .Cells(1).PasteSpecial Paste:=xlPasteFormats
                .Cells(1).Select
                Application.CutCopyMode = False
            End With

            'Create a file name
            TempFilePath = Environ$("temp") & "\"
            TempFileName = "Your data of " & Ash.Parent.Name _
                         & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            If Val(Application.Version) < 12 Then
                'You use Excel 97-2003
                FileExtStr = ".xls": FileFormatNum = -4143
            Else
                'You use Excel 2007-2016
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If

            'Save, Mail, Close and Delete the file
            Set OutMail = OutApp.CreateItem(0)

            fName = Range("D" & 2).Value
            lName = Range("E" & 2).Value
            AppName = Range("C" & 2).Value
            eError = Range("A" & 2).Value
            dDate = Format(Now(), "d mmmm yyyy")

            With NewWB
                .SaveAs TempFilePath & TempFileName _
                      & FileExtStr, FileFormat:=FileFormatNum
                On Error Resume Next
                With OutMail
                    .To = Cws.Cells(Rnum, 1).Value
                    .Cc = "email"
                    .SentOnBehalfOfName = FromMail
                    .Subject = "2nd Notification"
                    .Attachments.Add NewWB.FullName

                    .Display  'Or use Send
                End With
                On Error GoTo 0
                .Close savechanges:=False
            End With

            Set OutMail = Nothing
            Kill TempFilePath & TempFileName & FileExtStr
        End If
        'Close AutoFilter
        Ash.AutoFilterMode = False

    Next Rnum
End If
cleanup:
Set OutApp = Nothing
Application.DisplayAlerts = False
Cws.Delete
Application.DisplayAlerts = True

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

我不确定这是否与我调用专栏的方式或它的编写方式有关。我还认为带有电子邮件H的行将始终有一个电子邮件地址,它永远不会是空的,因此if语句甚至可能只关于if AF,正如Dave指出的,您的查询令人困惑。您声明您正在测试AF,但您正在查看第25列。查看代码的其余部分,您的表原点是A1,因此您希望测试AF的第32列

下面将测试A列是否符合您的原始测试电子邮件地址,以及AF列是否包含小于或等于7的数字

If cws.Cells(rnum, 1).Value Like "?*@?*.?*" And _
    Val(cws.Cells(rnum, 32) <= 7 Then

只是想澄清一下?列25将是列Y而不是列AF,除非您有指示从列开始的筛选的内容H@Davesexcel我编辑以包含整个代码这仍然不起作用,我有一个有4行的样本表,只有1行有其他3个AF单元格中的值?对于测试,我有7,15,6和12-所以它应该只创建2个emailsOkay,在这里我能想到的唯一一件事,除了奇怪的格式之外,就是值是文本。我会调整我的答案。
'If the unique value is a mail address create a mail
        If Cws.Cells(Rnum, 1).Value Like "?*@?*.?*" And _
        Cws.Cells(Rnum, "AF") <= "7" Then
If cws.Cells(rnum, 1).Value Like "?*@?*.?*" And _
    Val(cws.Cells(rnum, 32) <= 7 Then
If cws.Cells(rnum, 1).Value Like "?*@?*.?*" And _
    Val(cws.Cells(rnum, 32).value) <= 7 and cws.Cells(rnum, 32)<>"" Then
Debug.Print "Value in " & cws.Cells(rnum, 32).Address & " is: [" & cws.Cells(rnum, 32) & "]"