我在这一点上被难倒了。我已经尝试了几种方法,但现在感到沮丧是盲目的我。
下面是几乎按预期工作的当前代码。对于上下文-我试图自动生成一封电子邮件与pdf附件的基础上细胞的价值。
列F保存确认编号。有时,此确认编号显示为整数,有时包含小数。
查看路径时,初始路径将始终为“C:\Users\mypc”。之后的路径将根据工作表中的值而有所不同。下一个路径应该首先根据K列中的国家代码定位文件夹。然后,它需要检查文件夹中来自列F的确认号,但是该值需要首先向下舍入到最接近的整数,因为文件夹名称永远不会包含小数。一旦文件夹是根据确认号码定位,然后需要附加的pdf文件内。在向下舍入之前,pdf文件将始终与来自F的确认号完全匹配。
目前,唯一的问题是,它无法找到一个文件夹,如果名称包含更多的字符(例如。文件名是'1234 Tommy 21 Feb 23')它当前也仅被定向到查看1个文件夹(墨西哥),但需要参考列K以查找正确的国家/地区文件夹。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim emailRng As Range, cl As Range
Dim sTo As String
Set emailRng = Worksheets("POC&Airport Codes&KEY").Range("D3:D4")
If InStr(1, Target, "BPS", vbTextCompare) > 0 Then
' Code for "BPS" condition
ElseIf InStr(1, Target, "FRT", vbTextCompare) > 0 Then
' Code for "FRT" condition
ElseIf InStr(1, Target, "PG", vbTextCompare) > 0 Then
' Code for "PG" condition
ElseIf InStr(1, Target, "CP", vbTextCompare) > 0 Then
' Code for "CP" condition
ElseIf InStr(1, Target, "CSC", vbTextCompare) > 0 Then
' Code for "CSC" condition
ElseIf InStr(1, Target, "CEN", vbTextCompare) > 0 Then
' Code for "CEN" condition
ElseIf InStr(1, Target, "AFI", vbTextCompare) > 0 Then
' Code for "AFI" condition
ElseIf InStr(1, Target, "ATLAS", vbTextCompare) > 0 Then
' Code for "ATLAS" condition
End If
For Each cl In emailRng
sTo = sTo & ";" & cl.Value
Next
sTo = Mid(sTo, 2)
If Target.CountLarge > 1 Then Exit Sub
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Select Case Target.Column
Case Is = 16
Dim invoiceNumber As Double
invoiceNumber = Fix(Range("F" & Target.Row).Value) ' Round down to nearest whole number
Dim countryName As String
countryName = Range("K" & Target.Row).Value
Dim folderPath As String
folderPath = "C:\Users\mypc\Mexico\" & CStr(invoiceNumber) & "\"
Dim fileName As String
fileName = Range("F" & Target.Row).Value & ".pdf" ' File name
If Dir(folderPath, vbDirectory) <> "" Then ' Check if the folder exists
If Dir(folderPath & fileName) <> "" Then ' Check if the file exists in the folder
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = sTo
.CC = "CSREQUESTS@EMAIL.COM"
.Subject = Range("F" & Target.Row).Value & " " & Range("J" & Target.Row) & " " & Range("L" & Target.Row) & " " & Format(Range("A" & Target.Row), "dd-mmmm-yyyy") & " " & "CS"
.HTMLBody = "Please see the attached transportation request and confirm service at your earliest convenience.<br>" & Range("O" & Target.Row)
.Attachments.Add folderPath & fileName ' Add the attachment
.Display
End With
Else
MsgBox "File not found for the invoice number: " & Range("F" & Target.Row).Value & " in the folder for country: " & countryName
End If
Else
MsgBox "Folder not found for the invoice number: " & Range("F" & Target.Row).Value & " in the country: " & countryName
End If
End Select
Application.ScreenUpdating = True
End Sub
2条答案
按热度按时间zpqajqem1#
使用FileSystemObject检查
"C:\Users\mypc\
中所有子文件夹的唯一文件名将简化该过程。yh2wf1be2#
只关注文件夹/文件问题: