Mindyj

謝謝stillfish、是用反了，可是現在有另一個問題；資料有兩個人同時要接收時，程式判讀只會將最後一位列在收件者上面，請問這是哪個部份有誤?
另外請問夾帶檔案位置的部份一直測試不出來是語法錯誤嗎?謝謝

1. Sub SEND()
   
2.     Dim OutApp As Object
   
3.     Dim OutMail As Object
   
4.     Dim FileName As String
   
5.     Dim EmailTo As String
   
6.     Dim EmailCC As String
   
7.     Dim EmailBCC As String
   
8.     Dim EmailSubject As String
   
9.     Dim EmailBody As String
   
10.     Dim cell As Integer
    
11.    
    
12.     SendType = CStr(Sheets("Sheet2").Cells(2, 2))
    
13.      If SendType = "1" Then
    
14.         cell = 8
    
15.      ElseIf SendType = "2" Then
    
16.         cell = 9
    
17.      ElseIf SendType = "3" Then
    
18.         cell = 10
    
19.      ElseIf SendType = "4" Then
    
20.         cell = 11
    
21.      Else
    
22.         cell = 0
    
23.      End If
    
24. 
    
25.      If cell > 0 Then
    
26.         For i = 4 To 6 Step 1
    
27.             If CBool(Sheets("Sheet2").Cells(i, cell)) = "TRUE" Then
    
28.                 EmailTo = CStr(Sheets("Sheet2").Range("G" & i)) & ";"
    
29.             End If
    
30.         Next
    
31.             EmailCC = CStr(Sheets("Sheet2").Range("G" & 7))
    
32.             EmailBCC = CStr(Sheets("Sheet2").Range("G" & 8))
    
33.             EmailSubject = CStr(Sheet2.Cells(2, 3))
    
34.             EmailBody = CStr(Sheet1.Range("A" & 11)) & vbNewLine
    
35.             
    
36.             'If [Sheet1].Cells(8, 1) <> "" Then .AddAttachment ([Sheet1].Cells(8, 1))
    
37. 
    
38.             If EmailCC <> "" Then
    
39.                 Set rng = Sheets("Sheet1").Range("A11:G30").SpecialCells(xlCellTypeVisible)
    
40.                 On Error Resume Next
    
41.                 ' Only send the visible cells in the selection.
    
42.                 'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    
43.                 On Error GoTo 0
    
44.                 If rng Is Nothing Then
    
45. 
    
46.                     MsgBox "The selection is not a range or the sheet is protected. " & _
    
47.                            vbNewLine & "Please correct and try again.", vbOKOnly
    
48.                     Exit Sub
    
49.                 End If
    
50.                 With Application
    
51.                     .EnableEvents = False
    
52.                     .ScreenUpdating = False
    
53.                 End With
    
54. 
    
55.                 Set OutApp = CreateObject("Outlook.Application")
    
56.                 Set OutMail = OutApp.CreateItem(0)
    
57.            
    
58.                 On Error Resume Next
    
59.                 On Error GoTo 0
    
60. 
    
61.                 With OutMail
    
62.                      .To = EmailTo
    
63.                      .CC = EmailCC
    
64.                      .BCC = EmailBCC
    
65.                      .Subject = EmailSubject
    
66.                      .body = EmailBody
    
67. '                     .attachments.Add
    
68.                      .display
    
69.                  End With
    
70.                 With Application
    
71.                     .EnableEvents = True
    
72.                     .ScreenUpdating = True
    
73.                 End With
    
74.                 Set OutMail = Nothing
    
75.                 Set OutApp = Nothing
    
76.             End If
    
77.      End If
    
78. End Sub

複製代碼

stillfish00

回復 11# Mindyj
line#28
     EmailTo = EmailTo & CStr(Sheets("Sheet2").Range("G" & i)) & ";"

line#67
    .attachments.Add "C:\aa.txt"
    紅色為附檔的路徑

是這樣嗎?

Mindyj

回復 12# stillfish00


Hi stillfish,
夾帶檔案指定為shee1的a8儲存格，我使用了
                 .AddAttachment Sheet1.Cells(8, 1)
debug會停留在.addattachment

kimbal

回復 13# Mindyj


    試試?
.attachments.add Sheet1.Cells(8, 1)

不行的話會不會是A8上的附件位置有錯?

Mindyj

回復 14# kimbal

還是不是、很納悶，因為這一行不執行的話整個程式是沒問題的，應該是不需要另外寫function?

Mindyj

剛剛測試了如果將夾帶檔案直接輸入檔案位置是可行的，

可是使用者會依每次需求不同選擇不同的檔案、所以才將檔案位置指定輸入至Sheet1的A8儲存格，

但是當我將夾帶檔案改為指定至儲存格就一直出現錯誤，

而錯誤一直停留在.attachments.add Sheet1.Cells(8, 1)

stillfish00

回復 16# Mindyj
.attachments.add Sheet1.Cells(8, 1).value

Mindyj

回復 17# stillfish00
執行結果：object doesn't support this property or method

一個頭n個大、請問還有別的方式嗎?

stillfish00

回復 18# Mindyj
能附上執行會出錯的檔案看看嗎

Mindyj

回復 17# stillfish00


    更正!!!!成功了!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    謝謝stillfish!!!!!!:handshake