我一直在涉及VBA一段时间，并且对基础知识进行了一些了解，了解了一些关于最佳实践的知识（使事情变得灵活，防御性编程，试图预测会破坏和抢占它的东西，评论每一个如果可以，单行，正确记录），以及大量的谷歌搜索和决心，我写了我的第一个程序！不幸的是，我遇到一些错误，谷歌搜索没有给我一个答案，所以我想我会请求一些帮助。也就是说，为什么我在我的Outlook检查循环中获得END IF而没有IF错误，当我有IF？ （它在第一端触发，如果）。我的代码中是否还有其他明显的问题或问题？有没有更好的方法来做我想做的事情？
最后，当试图检查300k +电子邮件时，它会破坏多少... 4次？ （老实说，除了“检查所有事情”之外，我还没想到任何其他方法
谢谢
'The purpose of this macro is to automate and make easy extracting vendor pricing from the emails they send us daily, and to automate grabbing the information
'and turning it into a CSV file. Created by Olivier 03/10/17. In addition to the primary purpose of parsing out vendor email attachments, I was hoping to build
'the sheet in a flexible manner so that it could easily be adapted to any file parsing situation. The excel sheet has a data range to change who we're looking
'for e-mails from, what the subject of the email is, where we want to save the attachment, what we want to call the attachment, the name and location of the data
'in the attachment, a middle pivot for putting data into our sheet, and name and locations of the parsed files once we're done grabbing the data. In addition,
'The structure of the project is designed so that someone could execute additional functions on the parsed data before saving it down again - but that's not done here.
' The steps are as follows. 1) Look in Outlook for our e-mails. 2) Download attachments. 3) Open attachments. 4) Find a particular tab. 5) Copy that tab
' 6) Get that tab as its own CSV file.
Option Explicit
'Good practices. Not having VBA guess at what a variable is.
'The numbers next to some of the variables represent which column in the Excel table it exists in, to easily call it without having to reference back to the worksheet constantly
Dim SearchDate As Date 'Today
'The emails are coming in daily, and we only want to be looking for stuff from today. Yesterday's is right out
Dim SavepathAtch As String '2
'We need to download the attachment SOMEWHERE
Dim SearchSender As String '3
'The person who's sending us the e-mail
Dim SaveNameAtch As String '5
'Now that we have a save path, we also need a file name. I could of probably combined this with SavePathAtch....
Dim Vendor As String '1
'Each Vendor gets their own row. I need some way of referencing them. Maybe they should be an interger, since I really only need them as 1-N
Dim I As Integer
'Well, I need something to make loops work...
Dim SavePathProduct As String '9
'We'd like to save our atachments and our final products as different files, in different spots
Dim TabNameMid As String '7
'The tab name that we're saving the information to as a midpoint in the process. Could have been done better by a better programmer and cutting out
'The middle step, but I have no idea how
Dim WS As Excel.Worksheet
'Let's have some nice shortcuts
Dim SearchSubj As String '4
'And we need to define who's sent us the email to look for it
Public sFolders() As String
Sub All()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Alerts would slow us down - same with the screen flickering
Call CheckOutlook
I = 1
'Since we're messing with I in other parts of the code, might as well make sure it's properly reset. If this is the first time it's being used, I don't want
'VBA to automtically assign a random integer to it. AKA apparently best practices
If I < Range("How_Many_Vendors_Do_we_Have?") + 1 Then
'How many vendors do we have is a COUNTA on the excel sheet to figure out, you guessed it, how many vendors we have. We need to run once for each vendor.
' The +1 is if we have 4 vendors, we need to run 4 times. On time to do vendor 4, we'd be at number 4, so we need I to be under 5.
Vendor = Range("Vendor" & I)
'Vendor1, Vendor2, Vendor3, etc. are all a named range in Excel, representing the nth cell of the first column of the datarange name ranged in Excel.
'This is so that people can easily edit the information, and create their own rules and paths without needing to know any VBA.
SaveNameAtch = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 5, 0)
SavepathAtch = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 2, 0) & SaveNameAtch
' More stiching things together. Starting to think I really made a mistake doing it like this.
TabNameMid = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 7, 0)
'Since we've set everything up to be able to use a Vlookup to find it all, we're going to use vlookups damnit
Call sheetcreate
' Get the sheets created and cleared from using the sheet yesterday or whatever.
Call ImportData
'One we've cleared the landing pad, the data can land.
I = I + 1
' And once we've done it for one row, we need to do it for the next row! Row row row your rows
End If
Call SaveWorksheetsAsCsv
'Import then export each file one at a time
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'And now we turn alerts and screen flicking back on
End Sub
'''''' GetFolderNames; ProcessFolder
Sub CheckOutlook()
Dim N As Long
'For folders
Dim X As Variant
'For Folders
'Dim sTemp As String
'Shouldn't be needed
Dim objFolder As Folder
'More Folders
Dim objMail As MailItem
'The mail!
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object
Dim oOlatch As Object
' I got frustrated at things not working, and I just copy and pasted all of these in. I realize I don't need most of them to work, but I was fairly frustrated.
' I figured if I didn't use them, no harm, and where I did need to use them, they were declared how Outlook objections are usually declared.
Call GetFolderNames
'Acquire folders. ALL OF THEM!!
I = 1
'Since we're messing with I in other parts of the code, might as well make sure it's properly reset. If this is the first time it's being used, I don't want
'VBA to automtically assign a random integer to it.
If I < Range("How_Many_Vendors_Do_we_Have?") + 1 Then
Vendor = Range("Vendor" & I)
SearchSubj = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 4, 0)
SearchDate = Date
SavepathAtch = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 2, 0) & SaveNameAtch
SaveNameAtch = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 5, 0)
SearchSender = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 3, 0)
'Really, this is just about all the same as above. Date is today, path name is where we want to save it, the numbers are where they're located in the table.
For N = 1 To UBound(sFolders) - 1 'loop all folders
X = Split(sFolders(N), " || ")
' This is the part where I shamelessly googled until I found something working. I'm not quite sure how this is working. Kept in old comments, added my own
Set objFolder = Session.GetFolder
For Each objMail In objFolder.Items
'loop every mail in the folder - check every piece of mail
If objMail.Subject = SearchSubj Then
'If the subject is the one we're looking for....
If objMail.ReceivedTime = SearchDate Then
'And the date is the one we're looking for....
If objMail.From = SearchSender Then
'AND the sender is the correct sender...
If oOlItm.Attachments.Count <> 0 Then
'AND, heaven forbid, they forget to attach the email, it won't break.
For Each oOlatch In oOlItm.Attachments
oOlatch.SaveAsFile SavepathAtch
'SAVE ALL THE ATTACHMENTS! Don't care too much about the contents of the email
Exit For
'This Exit For is triggering an error message. I can't figure out why, and I haven't figure out how to keep debugging and ignoring the problem
End If
End If
End If
End If
Next objMail
'Alright, we've checked this e-mail. Onto the next one
Next N
'Next folder
I = I + 1
'Ok, we've checked every single piece of mail. Wait, what do you mean we have to do it again!? I sense some horrible, horrible inefficiencies....
' ... but I have no idea how else I'm going to do this.
End If
End Sub
Public Sub GetFolderNames()
Dim olApp As Outlook.Application
Dim olSession As Outlook.Namespace
Dim olStartFolder As Outlook.MAPIFolder
Dim lCountOfFound As Long
lCountOfFound = 0
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")
Set olStartFolder = olSession.PickFolder
ReDim sFolders(1 To 1) As String
If Not (olStartFolder Is Nothing) Then
ProcessFolder olStartFolder
End If
' Getting all of the folder names I suppose. This part took me hours and hours to try and figure out, and eventually I stumbled on someone elses code.
' Thank you Reddit.
End Sub
Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
Dim U As Long
Dim olNewFolder As Outlook.MAPIFolder
Dim olTempFolder As Outlook.MAPIFolder
Dim olTempFolderPath As String
Dim olCount As Long, lCountOfFound As Long
For U = CurrentFolder.Folders.Count To 1 Step -1
Set olTempFolder = CurrentFolder.Folders(U)
olTempFolderPath = olTempFolder.Folderpath
olCount = olTempFolder.Items.Count
ReDim Preserve sFolders(1 To UBound(sFolders) + 1) As String
sFolders(UBound(sFolders) - 1) = olTempFolderPath & " || " & CurrentFolder.EntryID
Next
For Each olNewFolder In CurrentFolder.Folders
If olNewFolder.Name <> "Deleted Items" Then
ProcessFolder olNewFolder
End If
'Sorting... through.. the folders? I guess?
'Had to change the I to a U. Can't repeat variables.
Next
End Sub
Sub ImportData()
' this is how we get data onto the main sheet. There probably exists a way somewhere to only save a particular tab from an attachment in an email. But until
' I know how to do that, we're going from San Fransisco to LA via Boston.
Dim PriceAttachment As Workbook
Dim PriceTab As String ' 6
Dim DataRange As String
PriceTab = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 6, 0)
'Defining stuff
SaveNameAtch = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 5, 0)
SavepathAtch = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 2, 0) & SaveNameAtch
TabNameMid = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 7, 0)
'Location of the report
Workbooks.Open Filename:=SavepathAtch
'Opening up the file
Set SaveNameAtch = ActiveWorkbook
'Getting to the file
SaveNameAtch.Activate
ThisWorkbook.Sheets.TabName
'Getting to the right tab.
Cells.Select
'Selecting the new data
Selection.Copy
'Copying the new data
ThisWorkbook.Sheets(TabNameMid).Activate
'Getting back to the current sheet
Range("A1").Select
'And finding where to paste the data
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Pasting the data
SaveNameAtch.Close SaveChanges:=False
'Close the location of the new data without changing anything
End Sub
Sub SaveWorksheetsAsCsv()
'AND HE MAKES THE SAVE!
Dim SaveParsedfilename As String '10
Dim SavedParsedFilePath As String '9
'Like frankenstien's monter, we're going to stich these two together
SaveParsedfilename = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 10, 0)
SavedParsedFilePath = Application.WorksheetFunction.VLookup(Vendor, Range("DataRange"), 9, 0) & SaveParsedfilename
'EGOR! COME QUICK! IT'S ALIVE!!!
For Each WS In ThisWorkbook.Worksheets
'Save ALL THE SHEETS!
If WS.Name <> "Instructions" Then
'Except this one. We don't like this one
WS.SaveAs SavedParsedFilePath & SaveParsedfilename, xlCSV
'Save.exe
End If
'We've loaded each save onto the arc. Wait, what do you mean we forgot the dinosuars and instruction tab?
Next
End Sub
Sub sheetcreate()
'This is to clear out the old data, and make sure every tab exists and is clear
Sheets(TabName).Delete
'Boom, headshot. Erased. Deleted. Gone.
Set WS = Sheets.Add
WS.Name = TabName
'How can you kill that which has no life? Reanime all of the sheets.
End Sub
答案 0 :(得分：2)
我得到它编译！有一些错误。
首先，你的＆＃34; If，End If＆＃34;问题是由于缺少＆＃34;下一步＆＃34;在嵌套的中心＆＃34; For Loops。＆＃34;它位于＆＃34; For Loop＆＃34;你在哪里保存文件。
此外，您的Tabname与TabNameMid存在问题。看起来你要设置一个变量，但从来没有。有一行，thisworkbook.sheets.tabname，它需要一个索引。 （.sheets（index））
还有其他几个tabname问题。放入＆＃34;下一步后，您将找到它们。＆＃34;
For Each oOlatch In oOlItm.Attachments
oOlatch.SaveAsFile SavepathAtch
'SAVE ALL THE ATTACHMENTS! Don't care too much about the contents of the email
Next 'this is the Next that you are missing