ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

excel¶l¥ó±Hµo¦h°ÝÃD

excel¶l¥ó±Hµo¦h°ÝÃD

½Ð°Ý¦U¦ì¥ý¶i¶l¥óµo°eªº°ÝÃD¡A¦¹Àɮ׬O®Ú¾Ú¨Ï¥ÎªÌªº¿ï¾Ü¶i¦æ¶l¥óµo°e¡A¥Ø«eªº°ÝÃD¦p¤U¡G
1.Åý¨Ï¥ÎªÌ¥Hsheet1¿ï¾Ü­n§¨±aªºÀɮצì¸m¡A¦bÂI¿ïimport®É·|¥X²{Application.GetOpenFilename¡A¸Ì­±¥i¥H¿ï¾Ü¦U¦¡ªºÀÉ®×(ex¡GPDF¡BTXT¡BWORD¡BEXCEL)¡A¦b¿ï¨úÀɮ׫á·|±NÀɮצì¸mÅã¥Ü¦bÀx¦s®æc7ªº¦ì¸m


2.®Ú¾Ú¨Ï¥ÎªÌªº¿ï¾Ü±ø¥ó¡A±N³ø§iÃþ§O¨Ìsheet2¤¤¤£¦P¦¬«HªÌªº­n¨D¶i¦æ±Hµo¶l¥ó¡A·í¤¤©Ò¹J¨ìªº°ÝÃD¡G
  2.1 ±N©Ò¿ï¾Üªº³ø§iÂରpdf¨Ã§¨±a
  2.2 ±N©Ò¿ï¾Üªº³ø§i¥Hhtml«¬¦¡©ñ¦b¶l¥óªº¥D¤å¤¤
  2.3 ¿ï¾Üªº³ø§i«¬ºA¡A¨Ì¦¬¥óªÌ¤£¦Pªº»Ý¨D¶i¦æµo°e(TRUE¥Nªíµo°e¡BFALSE¥Nªí¤£µo°e)
  2.4 ¶l¥ó§À´¡¤Jñ¦WÀÉ
  2.5 SHEET1¤¤ªºµo°e«öÁä·|¨Ì¨Ï¥ÎªÌ©Ò¿ï¨úªº¥\¯à¶i¦æ¶l§½µo°e¡AÅã¥Ü©óOUTLOOK¤¤¶i¦æ½T»{

3. ¼W¥[¦¬¥óªÌc.c.»Pb.c.c.¡A¼ÐÃD¬°³ø§i«¬ºA¡A¥D¤åªº°Ý­Ô»y«h°Ñ·ÓA10¤§«áªº¤º¤å¡C

¥H¤W°ÝÃD¡A¸ê½è¤£¨¬¡A¬ã¨s¤F¤@­Ó¤ëÁÙ¬O¸Ñ¨M¤£¤F¡A³Â·Ð¤j®aÀ°¦£¡CÁÂÁÂ

Book1.rar (9.22 KB)

Book1.rar (9 KB)

¥Ø«e¬ã¨s¥X¿ï¨ú§¨±aÀɮ׸ô®|¬°¡G
  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
½Æ»s¥N½X
¥Ø«e´¡¤J¸ô®|ªº¦ì¸m¬°a1¡A½Ð°Ý­n¦p¦ó«ü©w´¡¤JªºÀx¦s®æ¦ì¸m©O?ÁÂÁÂ

TOP

¥»©«³Ì«á¥Ñ stillfish00 ©ó 2013-5-27 11:23 ½s¿è

¦^´_ 2# Mindyj
14¦æ§ï³o¼Ë´NÀH§A«ü©w¤F
if i=0 then
  Sheet1.Range("A1")= strFullName
else
  Sheet1.Range("A1").Offset(i - 1) = strFullName
end if


rinstr ¨ä¹ê¦³²{¦¨¨ç¼Æ InStrRev ¥i§Q¥Î

TOP

µ§»~...if i=1 then ¤~¹ï

TOP

¦^´_ 4# stillfish00
ÁÂÁÂstillfish¡A´ú¸Õµ²ªG¤£½×i=0 or=1¬Ò¥i¨Ï¥Î¡A¥i§_½Ðstillfish«ü±Ð¦p¦ó¨Ï¥Î InStrRev ©O?  ÁÂÁÂ

TOP

¦^´_ 5# Mindyj
¥Îªk©M§A­ì¥»ªº®t¤£¦h¡A¹³2¼Ó 16¦æ ¼g¦¨ n = InStrRev(strFullName, "\") ¤@¼Ë¬O§ä³Ì«á¤@­Ó "\"¥X²{ªº¦ì¸m¡C

¨ä¥L¿ï¾Ü©Ê¤Þ¼Æ´N¦Û¤v¬d¬Ý»¡©úÂP¡C

InStrRev¨ç¼Æ
´y­z
¶Ç¦^¤@­Ó¦r¦ê¦b¥t¤@­Ó¦r¦ê¤¤¥X²{ªº¦ì¸m¡A±q¦r¦êªº¥½§Àºâ°_¡C

»yªk
InstrRev(stringcheck, stringmatch[, start[, compare]])

InstrRev ¨ç¼Æ»yªk¦³¦p¤U´X­Ó«ü¦W¤Þ¼Æ¡G
stringcheck ¥²­n¤Þ¼Æ¡C­n°õ¦æ·j´Mªº¦r¦ê¹Bºâ¦¡¡C
stringmatch ¥²­n¤Þ¼Æ¡C­n·j´Mªº¦r¦ê¹Bºâ¦¡¡C
Start ¿ï¾Ü©Ê¤Þ¼Æªº¡C¼Æ­È¹Bºâ¦¡¡A³]©w¨C¦¸·j´Mªº¶}©l¦ì¸m¡C¦pªG©¿²¤¡A«h¨Ï¥Î -1¡A¥¦ªí¥Ü±q¤W¤@­Ó¦r¤¸¦ì¸m¶}©l·j´M¡C¦pªG start ¥]§t Null¡A«h²£¥Í¤@­Ó¿ù»~¡C
Compare ¿ï¶µªº¡C¼Æ¦r­È¡A«ü¥X¦b§PÂ_¤l¦r¦ê®É©Ò¨Ï¥Îªº¤ñ¸û¤èªk¡C¦pªG©¿²¤¡A«h°õ¦æ¤G¶i¦ì¤ñ¸û¡CÃö©ó¨ä­È¡A½Ð°Ñ¾\¡u³]©w­È¡v¡C

TOP

¦^´_ 6# stillfish00
¦¬¨ì¡BÁÂÁ±z!

TOP

¥Ø«eµ{¦¡¥N½X¦p¤U¡A¤@ª½debug¦bIf CBool(Sheets("Sheet2").Cells(cell, i)) Then³o¤@¦æ¡A½Ð¦U¦ì¥ý¶i«ü±Ð¡C
  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.      If cell > 0 Then
  25.         For i = 4 To 6 Step 1
  26.           'debug¤@ª½°±¦b¤U­±³o¤@¦æ
  27.             If CBool(Sheets("Sheet2").Cells(cell, i)) Then
  28.                   EmailTo = CStr(Sheets("Sheet2").Cells(7, i))
  29.             End If
  30.             EmailCC = CStr(Sheets("Sheet2").Cells(8, i))
  31.             EmailBCC = CStr(Sheets("Sheet2").Cells(9, i))
  32.             EmailSubject = CStr(Sheet2.Range("B" & i))
  33.             EmailBody = CStr(Sheet1.Range("A" & i)) & vbNewLine

  34.             If EmailCC <> "" Then
  35.                 Set rng = Sheets("Sheet1").Range("A11:G30").SpecialCells(xlCellTypeVisible)
  36.                 On Error Resume Next
  37.                 ' Only send the visible cells in the selection.
  38.                 Set rng = Selection.SpecialCells(xlCellTypeVisible)
  39.                 On Error GoTo 0
  40.                 If rng Is Nothing Then

  41.                     MsgBox "The selection is not a range or the sheet is protected. " & _
  42.                            vbNewLine & "Please correct and try again.", vbOKOnly
  43.                     Exit Sub
  44.                 End If
  45.                 With Application
  46.                     .EnableEvents = False
  47.                     .ScreenUpdating = False
  48.                 End With

  49.                 Set OutApp = CreateObject("Outlook.Application")
  50.                 Set OutMail = OutApp.CreateItem(0)
  51.            
  52.                 On Error Resume Next
  53.                 On Error GoTo 0

  54.                 With OutMail

  55.                      .to = EmailTo
  56.                      .CC = EmailCC
  57.                      .BCC = EmailBCC
  58.                      .Subject = EmailSubject
  59.                      .body = EmailBody

  60.                 '     .attachments.add=strattached
  61.                      .display
  62.                  End With
  63.                 With Application
  64.                     .EnableEvents = True
  65.                     .ScreenUpdating = True
  66.                 End With
  67.                 Set OutMail = Nothing
  68.                 Set OutApp = Nothing
  69.             End If
  70.         Next
  71.      End If
  72. End Sub
½Æ»s¥N½X

TOP

§ó¥¿¡B¥Ø«e°ÝÃD¬O¥X¦b¦¬¥óªÌmail¤@ª½µLªkÅã¥Ü¦b¦¬¥óªÌÄæ(©Ò¦³¦¬¥óªÌ¦b¦P¤@«Ê«H¤º)

TOP

¦^´_ 9# Mindyj
Cells(¦C¸¹¡AÄ渹)
§A¬O¤£¬O§Ë¤Ï¤F?

TOP

        ÀR«ä¦Û¦b : ¡i»X½ªªº¦Û¥Ñ¡j¤H±`¦b¤°»ò³£¥i¥H¦Û¥Ñ¦Û¦bªº®É­Ô¡A«o³Q³oºØÀH¤ß©Ò±ýªº¦Û¥Ñ»X½ª¡AµêÂY®É¥ú¦Ó²@µLıª¾¡C
ªð¦^¦Cªí ¤W¤@¥DÃD