12
返回列表 上一主題 發帖

excel郵件寄發多問題

Mindyj
　暱稱: Mindy

中學生Rank: 2

帖子
31 
主題
6 
精華
0 
積分
59 
點名
0  
作業系統
win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
女 
註冊時間
2013-4-4 
最後登錄
2013-9-2 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-23 10:51 | 只看該作者

excel郵件寄發多問題

請問各位先進郵件發送的問題，此檔案是根據使用者的選擇進行郵件發送，目前的問題如下：
1.讓使用者以sheet1選擇要夾帶的檔案位置，在點選import時會出現Application.GetOpenFilename，裡面可以選擇各式的檔案(ex：PDF、TXT、WORD、EXCEL)，在選取檔案後會將檔案位置顯示在儲存格c7的位置


2.根據使用者的選擇條件，將報告類別依sheet2中不同收信者的要求進行寄發郵件，當中所遇到的問題：
  2.1 將所選擇的報告轉為pdf並夾帶
  2.2 將所選擇的報告以html型式放在郵件的主文中
  2.3 選擇的報告型態，依收件者不同的需求進行發送(TRUE代表發送、FALSE代表不發送)
  2.4 郵件尾插入簽名檔
  2.5 SHEET1中的發送按鍵會依使用者所選取的功能進行郵局發送，顯示於OUTLOOK中進行確認

3. 增加收件者c.c.與b.c.c.，標題為報告型態，主文的問候語則參照A10之後的內文。

以上問題，資質不足，研究了一個月還是解決不了，麻煩大家幫忙。謝謝

Book1.rar (9.22 KB)

Book1.rar (9 KB)

收藏 分享

Mindyj
　暱稱: Mindy

中學生Rank: 2

帖子
31 
主題
6 
精華
0 
積分
59 
點名
0  
作業系統
win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
女 
註冊時間
2013-4-4 
最後登錄
2013-9-2 
2#
發表於 2013-5-27 11:04 | 只看該作者
目前研究出選取夾帶檔案路徑為：
  1. Sub Import1()
  2. Dim fd As FileDialog
  3.     Set fd = Excel.Application.FileDialog(msoFileDialogFilePicker)
  4.    
  5.     fd.Filters.Add "Excel File", "*.xls*" 'set the catch function
  6.     fd.Filters.Add "Word File", "*.doc*"
  7.     fd.Filters.Add "Txt File", "*.txt*"
  8.     fd.Filters.Add "all files", "*.*"
  9.         
  10.     fd.Show 'show the dialog window
  11.    
  12.     For i = 1 To fd.SelectedItems.Count
  13.         strFullName = fd.SelectedItems(i)
  14.         Sheet1.Cells(i, 1) = strFullName   'appear the selection file name
  15.         
  16.         n = rinstr(strFullName, "\")
  17.       Next
  18. End Sub
  19. Function rinstr(ByVal t As String, ByVal s As String)
  20.     'search the last string position
  21.     Dim i As Integer
  22.     Dim n As Integer   
  23.     n = 0
  24.     For i = 1 To Len(t)
  25.         If Mid(t, i, 1) = s Then
  26.            n = i
  27.         End If
  28.     Next
  29.     rinstr = n
  30. End Function
複製代碼
目前插入路徑的位置為a1，請問要如何指定插入的儲存格位置呢?謝謝

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2013-5-27 11:20 | 只看該作者
本帖最後由 stillfish00 於 2013-5-27 11:23 編輯

回復 2# Mindyj
14行改這樣就隨你指定了
if i=0 then
  Sheet1.Range("A1")= strFullName
else
  Sheet1.Range("A1").Offset(i - 1) = strFullName
end if


rinstr 其實有現成函數 InStrRev 可利用

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
4#
發表於 2013-5-27 11:27 | 只看該作者
筆誤...if i=1 then 才對

TOP

Mindyj
　暱稱: Mindy

中學生Rank: 2

帖子
31 
主題
6 
精華
0 
積分
59 
點名
0  
作業系統
win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
女 
註冊時間
2013-4-4 
最後登錄
2013-9-2 
5#
發表於 2013-5-27 11:46 | 只看該作者
回復 4# stillfish00
謝謝stillfish，測試結果不論i=0 or=1皆可使用，可否請stillfish指教如何使用 InStrRev 呢?  謝謝

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
6#
發表於 2013-5-27 12:24 | 只看該作者
回復 5# Mindyj
用法和你原本的差不多，像2樓 16行 寫成 n = InStrRev(strFullName, "\") 一樣是找最後一個 "\"出現的位置。

其他選擇性引數就自己查看說明嚕。

InStrRev函數
描述
傳回一個字串在另一個字串中出現的位置，從字串的末尾算起。

語法
InstrRev(stringcheck, stringmatch[, start[, compare]])

InstrRev 函數語法有如下幾個指名引數：
stringcheck 必要引數。要執行搜尋的字串運算式。
stringmatch 必要引數。要搜尋的字串運算式。
Start 選擇性引數的。數值運算式，設定每次搜尋的開始位置。如果忽略，則使用 -1，它表示從上一個字元位置開始搜尋。如果 start 包含 Null，則產生一個錯誤。
Compare 選項的。數字值，指出在判斷子字串時所使用的比較方法。如果忽略，則執行二進位比較。關於其值，請參閱「設定值」。

TOP

Mindyj
　暱稱: Mindy

中學生Rank: 2

帖子
31 
主題
6 
精華
0 
積分
59 
點名
0  
作業系統
win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
女 
註冊時間
2013-4-4 
最後登錄
2013-9-2 
7#
發表於 2013-5-27 12:34 | 只看該作者
回復 6# stillfish00
收到、謝謝您!

TOP

Mindyj
　暱稱: Mindy

中學生Rank: 2

帖子
31 
主題
6 
精華
0 
積分
59 
點名
0  
作業系統
win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
女 
註冊時間
2013-4-4 
最後登錄
2013-9-2 
8#
發表於 2013-5-29 07:32 | 只看該作者
目前程式代碼如下，一直debug在If CBool(Sheets("Sheet2").Cells(cell, i)) Then這一行，請各位先進指教。
  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

  12.    

  14.     SendType = CStr(Sheets("Sheet2").Cells(2, 2))
  15.      If SendType = "1" Then
  16.         cell = 8
  17.      ElseIf SendType = "2" Then
  18.         cell = 9
  19.      ElseIf SendType = "3" Then
  20.         cell = 10
  21.      ElseIf SendType = "4" Then
  22.         cell = 11
  23.      Else
  24.         cell = 0
  25.      End If

  27.      If cell > 0 Then
  28.         For i = 4 To 6 Step 1
  29.           'debug一直停在下面這一行
  30.             If CBool(Sheets("Sheet2").Cells(cell, i)) Then
  31.                   EmailTo = CStr(Sheets("Sheet2").Cells(7, i))
  32.             End If
  33.             EmailCC = CStr(Sheets("Sheet2").Cells(8, i))
  34.             EmailBCC = CStr(Sheets("Sheet2").Cells(9, i))
  35.             EmailSubject = CStr(Sheet2.Range("B" & i))
  36.             EmailBody = CStr(Sheet1.Range("A" & i)) & vbNewLine

  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

  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

  55.                 Set OutApp = CreateObject("Outlook.Application")
  56.                 Set OutMail = OutApp.CreateItem(0)
  57.            
  58.                 On Error Resume Next
  59.                 On Error GoTo 0

  61.                 With OutMail

  63.                      .to = EmailTo
  64.                      .CC = EmailCC
  65.                      .BCC = EmailBCC
  66.                      .Subject = EmailSubject
  67.                      .body = EmailBody

  69.                 '     .attachments.add=strattached
  70.                      .display
  71.                  End With
  72.                 With Application
  73.                     .EnableEvents = True
  74.                     .ScreenUpdating = True
  75.                 End With
  76.                 Set OutMail = Nothing
  77.                 Set OutApp = Nothing
  78.             End If
  79.         Next
  80.      End If
  81. End Sub
複製代碼

TOP

Mindyj
　暱稱: Mindy

中學生Rank: 2

帖子
31 
主題
6 
精華
0 
積分
59 
點名
0  
作業系統
win 7 
軟體版本
office 2007 
閱讀權限
20 
性別
女 
註冊時間
2013-4-4 
最後登錄
2013-9-2 
9#
發表於 2013-5-29 07:41 | 只看該作者
更正、目前問題是出在收件者mail一直無法顯示在收件者欄(所有收件者在同一封信內)

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
10#
發表於 2013-5-29 12:53 | 只看該作者
回復 9# Mindyj
Cells(列號，欄號)
你是不是弄反了?

TOP

        靜思自在 : 君子立恆志，小人恆立志。
12
返回列表 上一主題