Changing save to Save as 2

[assets]

The code below works to email a word document using MAPI email programs

Option Explicit
 
 
Private Type MAPIMessage 'Mail
    Reserved       As Long
    Subject        As String
    NoteText       As String
    MessageType    As String
    DateReceived   As String
    ConversationID As String
    Flags          As Long
    RecipCount     As Long
    FileCount      As Long
End Type
 
Private Type MapiRecip 'Recipient
    Reserved   As Long
    RecipClass As Long
    Name       As String
    Address    As String
    EIDSize    As Long
    EntryID    As String
End Type
 
Private Type MapiFile 'File
    Reserved As Long
    Flags    As Long
    Position As Long
    PathName As String
    FileName As String
    FileType As String
End Type
 
 ' MAPI Return Codes
Private Const SUCCESS_SUCCESS = 0
Private Const MAPI_USER_ABORT = 1
Private Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Private Const MAPI_E_FAILURE = 2
Private Const MAPI_E_LOGIN_FAILURE = 3
Private Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Private Const MAPI_E_DISK_FULL = 4
Private Const MAPI_E_INSUFFICIENT_MEMORY = 5
Private Const MAPI_E_BLK_TOO_SMALL = 6
Private Const MAPI_E_TOO_MANY_SESSIONS = 8
Private Const MAPI_E_TOO_MANY_FILES = 9
Private Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Private Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Private Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Private Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Private Const MAPI_E_UNKNOWN_RECIPIENT = 14
Private Const MAPI_E_BAD_RECIPTYPE = 15
Private Const MAPI_E_NO_MESSAGES = 16
Private Const MAPI_E_INVALID_MESSAGE = 17
Private Const MAPI_E_TEXT_TOO_LARGE = 18
Private Const MAPI_E_INVALID_SESSION = 19
Private Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Private Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Private Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Private Const MAPI_E_MESSAGE_IN_USE = 22
Private Const MAPI_E_NETWORK_FAILURE = 23
Private Const MAPI_E_INVALID_EDITFIELDS = 24
Private Const MAPI_E_INVALID_RECIPS = 25
Private Const MAPI_E_NOT_SUPPORTED = 26
 
Private Const MAPI_ORIG = 0 'Recipient-Flags
Private Const MAPI_TO = 1
Private Const MAPI_CC = 2
Private Const MAPI_BCC = 3
 
Private Const MAPI_LOGON_UI = &H1 'Logon Flags
Private Const MAPI_NEW_SESSION = &H2
Private Const MAPI_FORCE_DOWNLOAD = &H1000
 
Private Const MAPI_LOGOFF_SHARED = &H1 'Logoff Flags
Private Const MAPI_LOGOFF_UI = &H2
 
Private Const MAPI_DIALOG = &H8 'Send-Mail-Flags
Private Const MAPI_NODIALOG = 0
 
Private Const MAPI_OLE = &H1
Private Const MAPI_OLE_STATIC = &H2
 
Private Const MAPI_UNREAD = &H1 'Mail-Flags
Private Const MAPI_RECEIPT_REQUESTED = &H2
Private Const MAPI_SENT = &H4
 
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam As Long, _
ByVal User As String, ByVal Password As String, ByVal Flags As Long, _
ByVal Reserved As Long, Session As Long) As Long
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session As Long, _
ByVal UIParam As Long, ByVal Flags As Long, ByVal Reserved As Long) As Long
Private Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" _
(ByVal Session As Long, ByVal UIParam As Long, Message As MAPIMessage, _
Recipient() As MapiRecip, File() As MapiFile, ByVal Flags As Long, _
ByVal Reserved As Long) As Long
Private Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam As Long, _
ByVal DelimStr As String, ByVal FilePaths As String, ByVal FileNames As String, _
ByVal Reserved As Long) As Long
 
 
Function SendIt(sRecip As String, sTitle As String, sText As String, sFile As String) As Boolean
Dim strTemp      As String
 Dim strError      As String
 Dim lngIndex      As Long
 Dim iFileCount As Integer
     
 Dim mRecip(0) As MapiRecip, mFile() As MapiFile, mMail As MAPIMessage
 Dim lSess As Long, lRet As Long
     
 On Error GoTo ErrorHandler
 SendIt = False
     
 'Add 2 trailing spaces to the text, this will be the position where the attachment goes to
 sText = sText & "  "
     
 'Recipient
 With mRecip(0)
      .Name = sRecip
      .RecipClass = MAPI_TO
   End With
     
    'File to send?
   If sFile <> "" Then
      ReDim mFile(0)
      With mFile(0)
      .FileName = sFile
      .PathName = sFile
      .Position = Len(sText) - 1
      .FileType = ""
      .Reserved = 0
   End With
      iFileCount = 1
   End If
     
    'Create Mail
   With mMail
      .Subject = sTitle
      .NoteText = sText
      .Flags = 0
      .FileCount = iFileCount
      .RecipCount = 1
      .Reserved = 0
      .DateReceived = ""
      .MessageType = ""
   End With
     
   'Post it
   'Logon: User = "" and Password = ""
  lRet = MAPILogon(0, "", "", MAPI_LOGON_UI, 0, lSess)
   If lRet <> SUCCESS_SUCCESS Then
       strError = "Error logging into messaging software. (" & CStr(lRet) & ")"
        GoTo ErrorHandler
   End If
     
    'Send the mail to the given recipients with the attached file without showing a dialog
   lRet = MAPISendMail(lSess, 0, mMail, mRecip, mFile, MAPI_NODIALOG, 0)
   If lRet <> SUCCESS_SUCCESS And lRet <> MAPI_USER_ABORT Then
        If lRet = 14 Then
            strError = "Recipient not found"
        Else
           strError = "Error sending: " & CStr(lRet)
        End If
        GoTo ErrorHandler
    End If
     
    lRet = MAPILogoff(lSess, 0, 0, 0)
     
   SendIt = True
    Exit Function
     
ErrorHandler:
    If strError = "" Then strError = Err.Description
    Call MsgBox(strError, vbExclamation, "MAPI-Error")
End Function

Sub Autoclose()
  
'Sub emailactivedocument()
 
    Dim Doc As Document
     
    Application.ScreenUpdating = False
    Set Doc = ActiveDocument
    Doc.Save
     
    SendIt "me@mysite.com", "A new Access Card for person below", "Hi, read this:", Doc.FullName
     
    Application.ScreenUpdating = True
    Set Doc = Nothing
End Sub

The form is populated by an access database, the problem is this save over the origional document ( then you can not use next time). What I tried to do is use saveas.
So need help with code to save temp document to the desktop and then attach this file. It could also include an auto delete once the file has been sent.

Any Ideas please

Never give up never give in.

There are no short cuts to anything worth doing

 

[kjv1611]

the problem is this save over the origional document ( then you can not use next time).

Sounds like what you need to do is create a TEMPLATE file, then in your code, create a new document off the template (default when you double-click on a template file).

References:

http://msdn.microsoft.com/en-us/library/aa140287(v=office.10).aspx

http://lmgtfy.com/?q=ms+word+vba+new+from+template

 

[assets]

Thank you for you good references. I have tried using Templates but it only save the file over that template file. I have tried using the followig code

    Dim strDocName As String
    Dim intPos As Integer

 strDocName = ActiveDocument.Name
    intPos = InStrRev(strDocName, ".")

    If intPos = 0 Then

        strDocName = InputBox("Please enter the name " & _
            "of your document.")
    Else

        strDocName = Left(strDocName, intPos - 1)
        strDocName = strDocName & ".txt"
    End If

ActiveDocument.SaveAs FileName:=strDocName, _
        FileFormat:=wdFormatText

I think I need to get it to change strDocName some how.

Any Ideas appreciated

Never give up never give in.

There are no short cuts to anything worth doing

 

[strongm]

>What I tried to do is use saveas.

Which should have been a reasonable solution. In what sense did it not work?

 

[Rofeu]

If I'm understanding your issue properly:

you don't want consecutive files to overwrite one and other.

If so: add a datetimestamp to the end of your filename.

One more thing:
instead of using an inputbox to obtain the filename, check out the Application.GetSaveAsFilename dialog.

Cheers,

Rofeu

 

[assets]

Rofeu,

Thank you for you information. The sub auto_close runs.

The input box does not come up as the file exist. What I like to do is be able to name the file. Does your getsaveas replace the if then else?

What I have done so far. It save a file to the desktop and then email that file.

    Dim strDocName As String
    Dim intPos As Integer
Dim NewName As String

 strDocName = ActiveDocument.Name
    intPos = InStrRev(strDocName, ".")

    If intPos = 0 Then

           strDocName = InputBox("Please enter the name " & _
            "of your document.")
    Else

        strDocName = Left(strDocName, intPos - 1)
        strDocName = strDocName & ".txt"
    End If

ActiveDocument.SaveAs FileName:="C:/documents and settings/all users/desktop/New Report.doc"
 
   
SendIt "me@mysite.nsw.com", "A new Access Card for person below", "Hi, read this:", "C:/documents and settings/all users/desktop/New Report.doc"
     
    Application.ScreenUpdating = True
   End Sub

Again thank for you help in this matter

Never give up never give in.

There are no short cuts to anything worth doing

 

[kjv1611]

Don't know why I didn't think about the datetime stamps.

assets,

If you use the template idea AND you use the datetime stamp, then you'll end up having a working solution very easily.

Also, if you are fine using the datetime stamp, you wouldn't need any prompt for the filename unless it was done twice in a row, and you could have an input box pop-up saying "file exists, choose anonother name..." or "File Exists, Overwrite, Rename, Cancel?..."

 

[Rofeu]

Hi,

my apologies, I was confusing Word and Excel.

For Word you can use:

Application.Dialogs(wdDialogFileSaveAs).Show


It calls the same dialog as when you'd click the option SaveAs.

So it comes instead of

strDocName = InputBox("Please enter the name " & _
"of your document.")

and the actual SaveAs codeline.


I am a bit confused as to what it is that's not working.

ActiveDocument.SaveAs FileName:=strDocName will save your file under the provided name just fine.

What I'm thinking is that you've created a template and are OPENING the template instead of CREATING A NEW DOCUMENT from the template. Am I correct?


another thing:
the auto_close is a very old bit of functionality. I'd use the Document_Close event instead.

Cheers,

Rofeu

 

[assets]

Thank you Rofeu,

Application.Dialogs(wdDialogFileSaveAs).Show will bring up the box.

How do I get NEWNAME so I can emai' that file?

SendIt "me@mysite.com", "A new Access Card for person below", "Hi, read this:", "NEWNAME"

Thanks again for good help

Never give up never give in.

There are no short cuts to anything worth doing

 

[SkipVought]

Did you look at HELP on the Dialogs collection?

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[assets]

Skip,
Do you mean getsavefilename

To get name and use it to equal strDocName



Never give up never give in.

There are no short cuts to anything worth doing

 

[Rofeu]

assets,

if you want to provide the SaveAsName yourself, just build the name in the code in strDocName and call the Doc.SaveAs method with your variable as the filename.

If you want people to be able to save the file under a different name of their choosing, call the dialog and just read the Doc.FullName into strDocName afterwards.


Cheers,

Rofeu

 

[assets]

Thanks for you help so far it good advice.

Tried doc.fullname could not get working.

What I done is

Dim strDocName As String
    Dim intPos As Integer
Application.Dialogs(wdDialogFileSaveAs).Show
strDocName = ActiveDocument.Name
    intPos = InStrRev(strDocName, ".")
SendIt "me&mysite.com", "A new Access Card for person below", "Hi, read this:", ActiveDocument

This works on my computer only on others give a mapi 19 error (invalid session).

Same windows XP sp3, Office 2003 sp3, Groupwise 7.0.4

Never give up never give in.

There are no short cuts to anything worth doing

 

[assets]

I removed outlook as it was causing problems and mow get an error 11 message which is atachment not found.

Never give up never give in.

There are no short cuts to anything worth doing

 

[kjv1611]

From where did you remove Outlook?

 

[assets]

Removed outlook with office setup program but have added groupwise libraries and it working again on my computer have not test others but expect may need to install libraries on each.

Never give up never give in.

There are no short cuts to anything worth doing

 

[kjv1611]

Ah, I was assuming you meant you removed it from the code somewhere.

 

[assets]

OK what I trying to work out how tho bring the send email window up and NOT populate the name so it cam be added by user.

Never give up never give in.

There are no short cuts to anything worth doing