Сохранить файл в определенном месте - PullRequest
0 голосов
/ 30 октября 2019

Я новичок в VBA, у меня есть макрос в Outlook VBA. Я хочу сохранить файл Excel в определенном месте.

Вот код, который я пробовал до сих пор:

Sub List_Email_Info()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim i As Long ' Row tracker
Dim arrHeader As Variant
Dim olNS As NameSpace
Dim olInboxFolder As MAPIFolder
Dim olItems As Items
Dim olMailItem As MailItem
Dim Cell As Range
Dim names As Variant            
Dim c As Integer


arrHeader = Array("Subject", "id", "num", "nom", "ville")
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add
Set olNS = GetNamespace("MAPI")
Set olInboxFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olInboxFolder.Items
  i = 1
On Error Resume Next
xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeader) + 1).Value = arrHeader
For Each olMailItem In olItems 
    xlWB.Worksheets(1).Cells(i + 1, "A").Value = olItems(i).Subject
     Do Until xlWB.Worksheets(1).Cells(i + 1, "A").Value = vbNullString
       names = Split(xlWB.Worksheets(1).Cells(i + 1, "A").Value, ";")      
        For c = LBound(names) To UBound(names)         
        xlWB.Worksheets(1).Cells(i + 1, "A").Offset(0, c + 1).Value = names(c)
        Next
       xlWB.Worksheets(1).Cells(i + 1, "A").Offset(1, 0).Select  ' Move to next row.
        DoEvents
        i = i + 1
    Loop    
Next olMailItem
Set xlWB = Nothing
Set xlApp = Nothing
Set olItems = Nothing
Set olI`enter code here`nboxFolder = Nothing
Set olNS = Nothing
End Sub

1 Ответ

0 голосов
/ 30 октября 2019

Попробуйте использовать функции, как показано ниже,

Функция GetOutputName (необязательный sKeyword As String, необязательный sDateStamp As String) As String

Dim sOutput As String
sDateStamp = Format(Now, "DDMMYYYY")

Select Case

    Case 0
        sOutput = "OutputFileName" & sDateStamp & ".xlsx"

    Case Else
        Call LogException("Invalid File Type when getting Output Name", "Report Type: " & g_iReportType, "There was an error defining the Output Name for this report. Please contact support.")

End Select

GetOutputName = sOutput

End Function

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...