Hai DD, Coba ubah bagian :
* If Trim(FileCell) <> "" Then* * If Dir(FileCell.Value) <> "" Then* * .Attachments.Add FileCell.Value* * End If* * End If* menjadi : * If Len(Dir(**Trim(FileCell.Value))) <> 0 Then* * .Attachments.Add trim(FileCell.Value)* * End If* Wassalam, Kid On Fri, Jul 3, 2015 at 5:23 PM, DD [email protected] [belajar-excel] <[email protected]> wrote: > > > *Dear Para Master,* > > > > *Mohon koreksinya terkait makro dbi :* > > > > *Sub Send_Files()* > > *'Working in Excel 2000-2013* > > *'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm > <http://www.rondebruin.nl/win/winmail/Outlook/tips.htm>* > > * Dim OutApp As Object* > > * Dim OutMail As Object* > > * Dim sh As Worksheet* > > * Dim cell As Range* > > * Dim FileCell As Range* > > * Dim rng As Range* > > > > * With Application* > > * .EnableEvents = False* > > * .ScreenUpdating = False* > > * End With* > > > > * Set sh = Sheets("Sheet1")* > > > > * Set OutApp = CreateObject("Outlook.Application")* > > > > * For Each cell In > sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)* > > > > * 'Enter the path/file names in the C:Z column in each row* > > * Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")* > > > > * If cell.Value Like "?*@?*.?*" And _* > > * Application.WorksheetFunction.CountA(rng) > 0 Then* > > * Set OutMail = OutApp.CreateItem(0)* > > > > * With OutMail* > > * .to = cell.Value* > > * .CC = Cells(cell.Row, 1).Range("d1:d1")* > > * .Subject = Cells(cell.Row, 1).Range("e1:e1")* > > * .Body = "" & cell.Offset(0, -1).Value* > > > > * For Each FileCell In > rng.SpecialCells(xlCellTypeConstants)* > > * If Trim(FileCell) <> "" Then* > > * If Dir(FileCell.Value) <> "" Then* > > * .Attachments.Add FileCell.Value* > > * End If* > > * End If* > > * Next FileCell* > > > > * .Send 'Or use .Display* > > * End With* > > > > * Set OutMail = Nothing* > > * End If* > > * Next cell* > > > > * Set OutApp = Nothing* > > * With Application* > > * .EnableEvents = True* > > * .ScreenUpdating = True* > > * End With* > > *End Sub* > > > > *Makro ini adalah untuk kirim email otomatis dengan lampirannya, kadang > berjalan sesuai keinginan kadang tidak.* > > *Kalau lagi bengkok ada pesan debug dan makronya seperti diatas dengan > satu baris berwarna kuning.* > > > > *Mohon solusinya.* > > > > *Salam,* > > *DD* > > ------------------------------ > This e-mail and any files transmitted with it are confidential and > intended solely for the use of the individual to whom it is addressed. If > you have received this email in error please send it back to the person > that sent it to you. Any views or opinions presented are solely those of > its author and do not necessarily represent those of NABATI or any of its > subsidiary companies. Unauthorized publication, use, dissemination, > forwarding, printing or copying of this email and its associated > attachments is strictly prohibited. > > >
