Question

有关于附件的快速提问。部分 - 我有一些VBA会询问用户是否要附加任何其他文档（Atach = MsgBox（“你想附加任何其他文件”，vbYesNo）到一个循环的电子邮件任务 - 但是，我需要找到一个更聪明的方法来警告用户.xls文件类型无法附加，也不允许它们仅附加该文件类型。

尝试过语法，但我想我错过了什么。我对VBA很新，所以感谢你的反馈。

Application.ScreenUpdating = False

Dim OutApp As Object
Dim OutMail As Object
Dim OutWordEditor As Object

Dim Tocell As Range
Dim SigString As String
Dim t               '' Overall timer after selecting files
Dim i As Integer    '' ASLS looping
Dim j As String    '' extra attachment
Dim x As Single     '' Delay timer
Dim valid As Integer

Dim titlestring As String
Dim FileW As Boolean
Dim Attachrng As String
Dim attach As String

Dim Worddoc As Object
Dim WordFile As String
Dim ToRangeCounter As Variant

Dim attachrange() As String

i = 0
j = 0
valid = 0
FileW = False
WordFile = ""

Atach = MsgBox("You have selected the Notifications Auto Email Macro",    vbYesNo)

If Atach = vbNo Then
            MsgBox ("Macro will now close")
            Exit Sub
            End If
WordFile = ""
FileW = False

Do Until FileW = True
WordFile = Application.GetOpenFilename(Title:="Select Notificatin to send as the email body", MultiSelect:=False)

Call Preview(WordFile)

Usercheck = MsgBox("Confirm this is correct ", vbYesNo)

If Usercheck = vbYes Then
FileW = True
End If
Loop
Else
MsgBox ("Please re select the file you wish to attach")
End If
Loop



***

Atach = MsgBox("Do you wish to attach any additional Documents", vbYesNo)
If Atach = vbYes Then

    For k = 0 To 1
    j = InputBox("How many files do you wish to attach?" & vbNewLine & "Only enter a number", "Enter a number here", 1)
    If Not IsNumeric(j) Then
        MsgBox ("You have failed to enter a number, please try again")
        k = 0
        valid = valid + 1
        If valid = 3 Then
            MsgBox ("You have failed to input a number 3 times" & vbNewLine & "Macro will now close")
            Exit Sub
            End If

        Else
            k = k + 1
            ReDim Preserve attachrange(j)
        End If
    Next

For Z = 1 To j
   titlestring = "You are attaching file number " & Z & " of " & j
   attachrange(Z) = Application.GetOpenFilename(Title:=titlestring, MultiSelect:=False)
   Next

  End If


On Error GoTo Cleanup

Answer 1

如果您使用Word的FileDialog，您可以做两件事。一，你可以过滤掉xlx文件。他们不会出现选择。第二，你可以允许多项选择，不再考虑用户想要添加多少的问题。您可以根据需要调整以下代码。

Function FilePicker(ByVal Tit As String, _
                    ByVal Btn As String, _
                    ByVal FltDesc As String, _
                    ByVal Flt As String, _
                    Fn As String, _
                    Optional Multi As Boolean = False) As Boolean
    ' 22 Mar 2017

    ' ==================================================
    '   Parameters:
    '       Tit               = Title
    '       Btn               = Button caption
    '       FltDesc           = Plain language filter
    '       Flt               = Filter string
    '       Fn                = Initial file name
    '                           Returns selected full file name
    ' ==================================================

    Dim FoD As FileDialog                           ' FilePicker Dialog

    ' ==================================================

    Set FoD = Application.FileDialog(msoFileDialogFilePicker)
    With FoD
        .Title = Tit
        .ButtonName = Btn
        .Filters.Clear
        .Filters.Add FltDesc, Flt, 1
        .AllowMultiSelect = Multi
        .InitialFileName = Fn
        If .Show Then
            Fn = .SelectedItems(1)
            FilePicker = True
        End If
    End With

    Set FoD = Nothing
End Function

然后，您可以处理用户附加的文件（可能使用其他方法或修改FileDialog）并检查附加文件的FileFormat property。删除你没有批准的任何内容。查找xlFileFormat常量以识别特定的文件格式。

VBA SYNTAX to EXCLUDE .XLS文件类型附加到批量电子邮件发送

1 个答案: