I currently have this next code in outlook VBA(found it in one of the topics here):
Public Sub FMK(Item As Outlook.MailItem)
Const PathName = "C:\Documents and Settings\Administrator\My Documents\files\Diary.xlsx"
Dim arrLines As Variant
Dim varLines As Variant
Dim RowNext As Long
Dim xlApp As Excel.Application
Dim ExcelWkBk As Excel.Workbook
Dim excWkb As Object
Dim excWks As Object
Dim temp As String
arrLines = Split(Item.Body, vbCrLf)
Set xlApp = Application.CreateObject("Excel.Application")
Set excWkb = xlApp.Workbooks.Open(PathName)
Set excWks = excWkb.ActiveSheet
RowNext = excWks.Cells.SpecialCells(xlCellTypeLastCell).Row + 1
With excWks
excWks.Cells(RowNext, 1) = temp
End With
RowNext = RowNext + 1
excWkb.SaveAs PathName
excWkb.Close
End Sub
Please help me ...
I need to update an Excel file that exists on my computer using a file that comes in Outlook ...
Always the same format files
I just want to add the lines that come Excel files by e-mail in addition to what is in the file on your PC
My knowledge is very limited in VBA
You can automate Outlook from Excel for extracting the required attached file. The Attachment class provides the SaveAs method which can be used to save the file on the disk. Then you can use the Open method of the Workbook class to open the just saved file.
See How to automate Outlook from another program for more information.
Related
I get 50 mails with Excel sheets per day. I want to add the first line of each Excel sheet to an existing Excel sheet located on my computer.
I know how to save a file from an email, and then access the first line. I would like to directly access it, without having to save the file.
Something like this:
Sub Merge_Reports(itm As Outlook.MailItem)
Dim wb_path As String
Dim app_master As Object
Dim wb_master As Object
Dim ws_master As Object
Dim objAtt As Outlook.Attachment
Dim ws_email As Object
Dim content As String
wb_path = "\\swi56prof01\UserData$\heinreca\Documents\Outlook-Dateien\AllData.xlsx"
Set app_master = CreateObject("Excel.Application")
Set wb_master = app_master.Workbooks.Open(wb_path)
Set ws_master = wb_master.Sheets(1)
For Each objAtt In itm.Attachments
Set ws_email = objAtt.Sheets(1)
content = ws_email.Cells("A1")
ws_master.Cells("A1") = content
End Sub
I am struggling with ws_email = objAtt.Sheets(1). I get the error
object doesn't support this property or method
I tried this instead of the line that results in the error.
Set app_email = CreateObject("Excel.Application")
Set wb_email = app_email.Workbooks.Open(objAtt)
Set ws_email = wb_email.Sheets(1)
I don't know what objAtt is in terms of data type and how to address the worksheet, so that I can copy the first line from it.
I found Copy Contents of Outlook Attachment and that I have to save the file before accessing it. Is there no other way?
There is no way to access the workbook without saving it to the disk. After saving the attached file to the disk you can use the same code:
Set wb_master = app_master.Workbooks.Open(wb_path)
Set ws_master = wb_master.Sheets(1)
where wb_path is the file path of your saved attachment (Excel file).
The Attachment.SaveAsFile method saves the attachment to the specified path. For example:
Sub SaveAttachment()
Dim myInspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myInspector = Application.ActiveInspector
If Not TypeName(myInspector) = "Nothing" Then
If TypeName(myInspector.CurrentItem) = "MailItem" Then
Set myItem = myInspector.CurrentItem
Set myAttachments = myItem.Attachments
'Prompt the user for confirmation
Dim strPrompt As String
strPrompt = "Are you sure you want to save the first attachment in the current item to the Documents folder? If a file with the same name already exists in the destination folder, it will be overwritten with this copy of the file."
If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
myAttachments.Item(1).SaveAsFile Environ("HOMEPATH") & "\My Documents\" & _
myAttachments.Item(1).DisplayName
End If
Else
MsgBox "The item is of the wrong type."
End If
End If
End Sub
I'm trying to search an MS Word doc for embedded Excel files and save them to a different location.
1) I want to record the page number and or section name (based on header style) the embedded file was located in the Word Doc. How can I extract this info?
2) Is there anyway to get the original filename of the embedded Excel file?
Here is the code I'm using to search for embedded files. Originally
Working off the code first presented here: Extract Embeded Excel Workseet Data
Sub TestMacro2()
Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone
Dim lNumShapes As Long
Dim lShapeCnt As Long
Dim xlApp As Object
Dim wrdActDoc As Document
Dim iRow As Integer
Dim iCol As Integer
Set wrdActDoc = ActiveDocument
For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
If wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.ProgID = "Excel.Sheet.8" Then
wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.Edit
Set xlApp = GetObject(, "Excel.Application")
cpath = "location of interest"
xlApp.Workbooks(1).SaveAs cpath & " " & lShapeCnt
xlApp.Workbooks(1).Close
xlApp.Quit
Set xlApp = Nothing
End If
End If
Next lShapeCnt
End Sub
Note: Your code would be more efficient (and easier to read) if you assign an object that's re-used to a variable:
Dim ils as Word.InlineShape
Set ils = wrdActDoc.InlineShapes(lShapeCnt)
(1) The Range.Information method can return the page number. Something like:
Dim pageNumber as Long
pageNumber = ils.Range.Information(wdwdActiveEndPageNumber)
The other option is not as straight forward... I expect you really mean Heading style, not Header style. There is a built-in bookmark that will get the Heading preceding the current selection. That would be something like:
Dim secName as String
ils.Range.Select
secName = ActiveDocument.Bookmarks("\HeadingLevel").Range.Text
(2) If the file is not linked then your chances are slim. There's nothing VBA can get at directly, that's certain. Possibly, something might be stored in the WordOpenXML. You can check that by downloading the Open XML SDK Productivity Tool, opening such a document in it and inspecting that part of the Open XML. If it's in there then you can get at it in VBA using ils.Range.WordOpenXML to get the Open XML for the InlineShape, then parse that.
after searching multiple things, and getting errors
How do I upon pressing "f5" in a vba script copy the body of an email into an excel sheet /csv
where every line = a new cell below.
Thanks
Sorry, this is causing me nothing but trouble.
What I have tried so far
http://smallbusiness.chron.com/export-outlook-emails-excel-spreadsheets-41441.html
How to copy Outlook mail message into excel using VBA or Macros
http://www.vbforums.com/showthread.php?415518-RESOLVED-outlook-the-macros-in-this-project-are-disabled
http://www.ozgrid.com/forum/showthread.php?t=181512
and a few more, last year.
This will work for you. we are basically splitting the email body into an array based on a new line. Notice that this will yield blank cells if you had a blank line in the email body.
Public Sub SplitEmail() ' Ensure reference to Word and Excel Object model is set
Dim rpl As Outlook.MailItem
Dim itm As Object
Set itm = GetCurrentItem()
If Not itm Is Nothing Then
Set rpl = itm.Reply
rpl.BodyFormat = olFormatHTML
'rpl.Display
End If
Dim objDoc As Word.Document
Set objDoc = rpl.GetInspector.WordEditor
Dim txt As String
txt = objDoc.Content.text
Dim xlApp As Excel.Application
Set xlApp = CreateObject("Excel.application")
xlApp.Visible = True
Dim wb As Excel.Workbook
Set wb = xlApp.Workbooks.Add
Dim i As Long
For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
wb.Worksheets(1).Range("A" & i + 1).Value = Split(txt, Chr(13))(i)
Next i
End Sub
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
End Select
GetCurrentItem.UnRead = False
Set objApp = Nothing
End Function
The Outlook object model doesn't recognize lines in the body. You can try to resize any inspector window in Outlook and see how the body lines are changed.
Anyway, you may try to use the Word object model to get the exact lines. Outlook uses Word as an email editor. The WordEditor property of the Inspector class returns an instance of the Document class which represents the message body. You can read more about all possible ways in the Chapter 17: Working with Item Bodies article.
The How to automate Microsoft Excel from Visual Basic article explains how to automate Excel from any external application.
I searched SO, SU, and SP.SE for a solution, but could not find what I needed. I'm looking for a solution which may be a script or some other non-coding method/tool.
I am trying to write a script (to be used by others) or some other form of automation to upload various reports automatically to a SharePoint site. I have managed to get the following (VBScript) code to work, but only for text-based files -- .CSV in this case, though this also works for .TXT, etc.
Option Explicit
Dim sCurPath
sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
UploadAllToSP sCurPath
Sub UploadAllToSP(sFolder)
Dim fso, folder, fil
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sFolder)
For Each fil In folder.Files
If fso.GetExtensionName(fil) = "csv" Then
UploadFileToSP fil
End If
Next
End Sub
Sub UploadFileToSP(ofile)
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Set tsIn = ofile.openAsTextstream
sBody = tsIn.readAll
tsIn.close
sharepointUrl = "http://SHAREPOINT URL HERE"
sharepointFileName = sharepointUrl & ofile.name
set xmlHttp = createobject("MSXML2.XMLHTTP.4.0")
xmlhttp.open "PUT", sharepointFileName, false
xmlhttp.send sBody
If xmlhttp.status < 200 Or xmlhttp.status > 201 Then
wscript.echo "There was a problem uploading " & ofile.name & "!"
End If
End Sub
This only works for text files because it pipes the text data into a file on the SP site. However, if I want to transfer any kind of binary file (.XLS, .PDF), this results in garbage being uploaded.
I tried to take a look at a Shell.Application ==> .Namespace(), but this doesn't seem to work with a URL, but only a physical drive. Here's some of what else I tried (trimmed to show relevant pieces):
Set oApp = CreateObject("Shell.Application")
If oApp.NameSpace(sharepointUrl) <> Null then ' Always Null!
' Copy here
' Some lines omitted
oApp.NameSpace(sharepointUrl).CopyHere ofile.Name ' This also fails when not surrounded by the Null check
Else
MsgBox "SharePoint directory not found!"
End If
I also tried a batch file using xcopy, but that can't connect to the http:// either. I looked at this method, which may work for me, but I'd prefer not to deal with mapping/NET USE, since our company has multiple network shares, the mapping for which varies depending on who's logged in.
Since none of these work quite the way I need: Is there a method to automate this kind of functionality?
I have experience with VBA/VBscript, so either a script like the above, or something built in to an MS Office application (Outlook is best, but I can probably adapt whatever I am given) would be preferable. That being said, I am open to any method that would allow me to do this, running natively in Windows or Office. However, I do not have access to Visual Studio, so I can't use any .NET functionality.
Thanks to Sean Cheshire for pointing me at the obvious answer that I did not see. Posting the relevant code, since I don't believe this yet exists on SO.
Sub UploadFilesToSP(sFolder)
Dim sharepointUrl
Dim sharepointFileName
Dim LlFileLength
Dim Lvarbin()
Dim LobjXML
Dim LvarBinData
Dim PstrFullfileName
Dim PstrTargetURL
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr
Dim f
'This has not been successfully tested using an "https" connection.
sharepointUrl = "http://SHAREPOINT URL HERE"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(sFolder)
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
PstrFullfileName = sFolder & f.Name
LlFileLength = FileLen(PstrFullfileName) - 1
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointFileName
' Put the data to the server, false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False
' Send the file in.
LobjXML.Send LvarBinData
Next f
Set LobjXML = Nothing
Set fso = Nothing
End Sub
This is VBA code, formatted to mostly work with VBScript, though I could not get this block to transfer properly. As VBA, this can be improved some by assigning data types, etc.
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
This is a very old post but a very useful one so thanks to everyone's contribution. This is my version with the early binding. I found that the previous posting didn't work due to VBA assumption of the none declared variable types.
Private Sub cmdUploadToApplicationsAndApprovals_Click()
Dim strSharePointUrl As String
Dim strSharePointFileName As String
Dim lngFileLength As Long
Dim bytBinary() As Byte
Dim objXML As XMLHTTP
Dim varBinData As Variant
Dim strFullfileName As String
Dim strTargetURL As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim folder As folder
Dim file As file
Dim strFolder As String
strFolder = CurrentProject.Path & "\Upload\"
'This has not been successfully tested using an "https" connection.
strSharePointUrl = "http://sps.mysite.ca/subsite/DocLib/"
Set objXML = New XMLHTTP 'CreateObject("Microsoft.XMLHTTP")
Set folder = fso.GetFolder(strFolder)
For Each file In folder.Files
strSharePointFileName = strSharePointUrl & file.Name
strFullfileName = strFolder & file.Name
lngFileLength = FileLen(strFullfileName) - 1
'Read the file into a byte array.
ReDim bytBinary(lngFileLength)
Open strFullfileName For Binary As #1
Get #1, , bytBinary
Close #1
'Convert to variant to PUT.
varBinData = bytBinary
strTargetURL = strSharePointFileName
'Put the data to the server, false means synchronous.
objXML.Open "PUT", strTargetURL, False
'Send the file in.
objXML.Send varBinData
'Now Update the metadata
Next file
'Clean up
Set objXML = Nothing
Set fso = Nothing
MsgBox "Done"
End Sub
FYI the above code required 2 references.
1. Microsoft XML, v6.0
2. Microsoft Scripting Runtime
Hope this helps improve on the already brilliant answer!!
I want to embed a word template in an Excel workbook so that the user can click on a generate report button and have word open a new document using the word template.
The below code directly edits the dotx and allows changes to be made to the template, which is undesirable as the template contains formatting and markup that supports the auto-report generation.
Public Sub ExportReportEmbedded()
Set curSheet = ActiveSheet
Application.ScreenUpdating = False
Dim wdApp As Word.Application, wdDoc As Word.Document
Set ole = Sheets("Report").Shapes("Object 4").OLEFormat
ole.Activate
' rather than activating it, I want to use the dotx in a new Word.Documents.Add().
' But how?
' wdApp.Documents.Add(ole.???)
curSheet.Activate
Set wdDoc = ole.Object.Object
Set q = Sheets("Report")
With wdDoc.ContentControls
For i = 1 To 62 Step 1
.Item(i).Range.Text = q.Range("b" & i)
Next
End With
Application.ScreenUpdating = True
End Sub
The below code directly edits the dotx and allows changes to be made to the template, which is undesirable as the template contains formatting and markup that supports the auto-report generation.
To directly answer your question, you can open the embedded Dotx in the following way so that the template itself is not opened but another word document based on the template.
Hope this is what you wanted?
Sub Sample()
Dim shp As Shape
Set shp = Sheets("Report").Shapes.Range(Array("Object 4"))
shp.Select
Selection.Verb Verb:=xlPrimary
End Sub
FOLLOWUP
Try this. I am using the GetTempPath API to get the user's temp folder and then saving the embedded document to that folder. Once the document is saved then I am using the .Add to create the new file. Also I am using Late Binding with MS Word so you do not need to set any references to MS Word Object Library. Do let me know if you have any queries :)
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Sub ExportReportEmbedded()
Dim oWordApp As Object, oWordDoc As Object, objWord As Object
Dim FlName As String
Dim sh As Shape
Dim objOLE As OLEObject
'~~> Decide on a temporary file name which will be saved in the
'~~> users temporary folder
FlName = GetTempDirectory & "\Template.dotx"
Set sh = Sheets("Report").Shapes("Object 4")
sh.OLEFormat.Activate
Set objOLE = sh.OLEFormat.Object
Set objWord = objOLE.Object
'~~> Save the file to the relevant temp folder
objWord.SaveAs2 fileName:=FlName, FileFormat:=wdFormatXMLTemplate
'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = True
'~~> Create new document based on the template
Set oWordDoc = oWordApp.Documents.Add(Template:=FlName, NewTemplate:=False, DocumentType:=0)
'~~> Close the actual template that opened
objWord.Close savechanges:=False
'~~> Rest of the code
'~~> now you can work with oWordDoc. This will not save the actual template
'~~> In the end Clean Up (Delete the template saved in the temp directory)
Kill FlName
End Sub
'~~> Function to get the user's temp directory
Function GetTempDirectory() As String
Dim buffer As String
Dim bufferLen As Long
buffer = Space$(256)
bufferLen = GetTempPath(Len(buffer), buffer)
If bufferLen > 0 And bufferLen < 256 Then
buffer = Left$(buffer, bufferLen)
End If
If InStr(buffer, Chr$(0)) <> 0 Then
GetTempDirectory = Left$(buffer, InStr(buffer, Chr$(0)) - 1)
Else
GetTempDirectory = buffer
End If
End Function