Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/17.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181

Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/url/2.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
VBA代码未填充工作表_Vba_Excel_Outlook - Fatal编程技术网

VBA代码未填充工作表

VBA代码未填充工作表,vba,excel,outlook,Vba,Excel,Outlook,下面的代码来自另一个SO帖子: 其目的是从Outlook电子邮件中查找信息并将其放入Excel Sub test2() Dim olApp As Outlook.Application Dim olNs As Outlook.Namespace Dim olFolder As Outlook.MAPIFolder Dim olMail As Outlook.MailItem Dim eFolder As Outlook.Folder Dim i As Long Dim x As Date Dim

下面的代码来自另一个SO帖子:

其目的是从Outlook电子邮件中查找信息并将其放入Excel

Sub test2()
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim eFolder As Outlook.Folder
Dim i As Long
Dim x As Date
Dim wb As Workbook
Dim ws As Worksheet
Dim iCounter As Long
Dim lrow As Long

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
wb.Activate
ws.Select

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
x = Date


For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
For i = olFolder.Items.Count To 1 Step -1

 If TypeOf olFolder.Items(i) Is MailItem Then
        Set olMail = olFolder.Items(i)
            For iCounter = 2 To lrow
            If InStr(olMail.SenderEmailAddress, ws.Cells(iCounter, 5).Value) > 0 Then
                With ws
                   lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                   .Range("A" & lrow).Offset(1, 0).Value = olMail.Subject
                   .Range("A" & lrow).Offset(1, 1).Value = olMail.ReceivedTime
                   .Range("A" & lrow).Offset(1, 2).Value = olMail.SenderEmailAddress
                End With
            End If
            Next iCounter
        End If
    Next i
    Set olFolder = Nothing
Next eFolder
端接头

当我调试并停留在最后几行时,代码似乎正确地从Outlook中提取信息。但是,提取的数据(电子邮件主题等)没有填充到我的工作表中。从我能收集到的信息来看,我已经正确设置了工作表变量,但我真的不知道发生了什么

谢谢你的帮助


更新:


工作表正在填充。我正试图让代码遍历一列电子邮件地址,如果地址与我的文件夹中的地址匹配,则从电子邮件中提取“收到的时间”。

您要查找的电子邮件是在收件箱中还是在子文件夹中?代码只查看收件箱中的每个文件夹,而不查看实际的收件箱

尝试以下更改:

Dim i As Long, j As Long 'Add "j as long"
'For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
For j = 0 To olNs.GetDefaultFolder(olFolderInbox).Folders.Count ' loop through the folders, starting at 0 (which we'll call the inbox)
    If j = 0 Then
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox)
    Else
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(j)
    End If
...rest of loop
Next ' Remove 'efolder' from here

做了一些改变。看看这是否有效

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim eFolder As Outlook.folder
Dim i As Long
Dim x As Date
Dim wb As Workbook
Dim ws As Worksheet
Dim iCounter As Long
Dim lrow As Long

Set wb = ActiveWorkbook
Set ws = wb.WorkSheets("Sheet1")

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
x = Date

'i think you want column E here, not L?
lastRow = ThisWorkbook.WorkSheets("Sheet1").Cells(Rows.Count, "L").End(xlUp).Row

For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.name)
For i = olFolder.Items.Count To 1 Step -1
For iCounter = 2 To lastRow
 If TypeOf olFolder.Items(i) Is MailItem Then
        Set olMail = olFolder.Items(i)
            If InStr(olMail.SenderEmailAddress, ws.Cells(iCounter, 5).Value) > 0 Then 'qualify the cell
                With ws
                   lrow = .Range("A" & .Rows.Count).End(xlUp).Row
                       .Range("A" & lrow + 1).Value = olMail.SUBJECT
                       .Range("B" & lrow + 1).Value = olMail.ReceivedTime
                       .Range("C" & lrow + 1).Value = olMail.SenderEmailAddress
                End With
            End If
            Next iCounter
        End If
    Next i
    Set olFolder = Nothing

@findwindow instr函数正在查看今天的日期是否在接收日期行中。我敢打赌问题是今天没有电子邮件可以查看,这将返回0。或者没有包含“提醒”的主题行。编辑:我猜OP并不真正理解代码的作用,因为它似乎是从原始代码直接复制和粘贴的。您不应该使用
InStr(olMail.ReceivedTime,x)
来比较时间/日期。为ReceivedTime创建另一个日期类型变量。然后与它们的
Year()
Month()
Day()
部分进行比较。好吧,您的代码XD中没有
iCounter
,或者您添加了它?是否更新OP以反映最新代码?另外,请开始删除注释以减少混乱。要查看工作表,您需要限定单元格,我们可能需要第二个计数器。更新了操作代码。我确实在lastRow和lastRow=ThisWorkbook.Worksheets(“Sheet1”).Cells(Rows.Count,“L”).End(xlUp)Row中添加了
dim iCounter作为长的
行,以及
For iCounter=2的
。现在没有编译错误,但工作表没有填充,当我调试它时,它会遍历所有行,但跳过
.Range(“A”&lrow).Offset(1,0).Value=olMail.Subject.Range(“A”&lrow).Offset(1,1).Value=olMail.ReceivedTime.Range(“A”&lrow).Offset(1,2).Value=olMail.SenderEmailAddress
是,它现在可以工作了!我正在查看您的代码,我意识到我尝试了一种变体,它包含了您代码的所有组件(
lastRow=thishworkbook.WorkSheets(“Sheet1”).Cells(Rows.Count,“L”).End(xlUp).Row,
但它以前不起作用。我在尝试您的代码时意识到了错误-我在工作簿中输入了参考电子邮件地址Darrin@gmail,应该是什么时候darrin@gmail-直到我做了那个小调整,你的代码才起作用。现在我的变体也起作用了!非常感谢我学到了很多,也感谢你的cri前面的提示:)嗯,尝试使用
InStr(olMail.SenderEmailAddress,ws.Cells(i,5.Value,vbTextCompare)
with
Darrin@gmail
它给了我一个类型不匹配错误。为了以防万一,我取出了for/next I计数器行,但仍然是相同的错误。如果没有办法解决案件敏感性问题,我很好,我感谢你的帮助!