- ©«¤l
- 31
- ¥DÃD
- 6
- ºëµØ
- 0
- ¿n¤À
- 59
- ÂI¦W
- 0
- §@·~¨t²Î
- win 7
- ³nÅ骩¥»
- office 2007
- ¾\ŪÅv
- 20
- ©Ê§O
- ¤k
- µù¥U®É¶¡
- 2013-4-4
- ³Ì«áµn¿ý
- 2013-9-2
|
ÁÂÁÂstillfish¡B¬O¥Î¤Ï¤F¡A¥i¬O²{¦b¦³¥t¤@Ó°ÝÃD¡F¸ê®Æ¦³¨âÓ¤H¦P®Én±µ¦¬®É¡Aµ{¦¡§PŪ¥u·|±N³Ì«á¤@¦ì¦C¦b¦¬¥óªÌ¤W±¡A½Ð°Ý³o¬OþÓ³¡¥÷¦³»~?
¥t¥~½Ð°Ý§¨±aÀɮצì¸mªº³¡¥÷¤@ª½´ú¸Õ¤£¥X¨Ó¬O»yªk¿ù»~¶Ü?ÁÂÁÂ- Sub SEND()
- Dim OutApp As Object
- Dim OutMail As Object
- Dim FileName As String
- Dim EmailTo As String
- Dim EmailCC As String
- Dim EmailBCC As String
- Dim EmailSubject As String
- Dim EmailBody As String
- Dim cell As Integer
-
- SendType = CStr(Sheets("Sheet2").Cells(2, 2))
- If SendType = "1" Then
- cell = 8
- ElseIf SendType = "2" Then
- cell = 9
- ElseIf SendType = "3" Then
- cell = 10
- ElseIf SendType = "4" Then
- cell = 11
- Else
- cell = 0
- End If
- If cell > 0 Then
- For i = 4 To 6 Step 1
- If CBool(Sheets("Sheet2").Cells(i, cell)) = "TRUE" Then
- EmailTo = CStr(Sheets("Sheet2").Range("G" & i)) & ";"
- End If
- Next
- EmailCC = CStr(Sheets("Sheet2").Range("G" & 7))
- EmailBCC = CStr(Sheets("Sheet2").Range("G" & 8))
- EmailSubject = CStr(Sheet2.Cells(2, 3))
- EmailBody = CStr(Sheet1.Range("A" & 11)) & vbNewLine
-
- 'If [Sheet1].Cells(8, 1) <> "" Then .AddAttachment ([Sheet1].Cells(8, 1))
- If EmailCC <> "" Then
- Set rng = Sheets("Sheet1").Range("A11:G30").SpecialCells(xlCellTypeVisible)
- On Error Resume Next
- ' Only send the visible cells in the selection.
- 'Set rng = Selection.SpecialCells(xlCellTypeVisible)
- On Error GoTo 0
- If rng Is Nothing Then
- MsgBox "The selection is not a range or the sheet is protected. " & _
- vbNewLine & "Please correct and try again.", vbOKOnly
- Exit Sub
- End If
- With Application
- .EnableEvents = False
- .ScreenUpdating = False
- End With
- Set OutApp = CreateObject("Outlook.Application")
- Set OutMail = OutApp.CreateItem(0)
-
- On Error Resume Next
- On Error GoTo 0
- With OutMail
- .To = EmailTo
- .CC = EmailCC
- .BCC = EmailBCC
- .Subject = EmailSubject
- .body = EmailBody
- ' .attachments.Add
- .display
- End With
- With Application
- .EnableEvents = True
- .ScreenUpdating = True
- End With
- Set OutMail = Nothing
- Set OutApp = Nothing
- End If
- End If
- End Sub
½Æ»s¥N½X |
|