Results 1 to 7 of 7

Thread: This is a test Test Let it be

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Grand Master
    Join Date
    Apr 2011
    Posts
    22
    Rep Power
    10
    Well, I'll be

    Code:
    Option Explicit
    
    Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
    
    
    Sub SaveEmailAttachmentsToFolder()
    
    
        Dim objApp As Application
        Dim objSession As NameSpace
        Dim objStartFolder As MAPIFolder
        Dim objAtmt As Attachment
        Dim objItem As Object
        Dim lngCount As Long
        Dim strDestinationFolder As String
        Dim strFileName As String
    
    
        'On Error GoTo Err_Handler
    
    
        Set objApp = GetObject(, "Outlook.Application")
        Set objSession = objApp.GetNamespace("MAPI")
        Set objStartFolder = objSession.PickFolder
    
    
        lngCount = 0
        ' Check subfolder for messages and exit of none found
        If objStartFolder.Items.Count = 0 Then
            MsgBox "There are no messages in this folder : " & objStartFolder.Name, vbInformation, "Nothing Found"
            GoTo ThisMacro_exit
        End If
    
    
        'Create strDestinationFolder if strDestinationFolder = ""
        strDestinationFolder = BrowseForFolder + "\"
        strDestinationFolder = ConvertToUNC(strDestinationFolder)
        ' Check each message for attachments and extensions
        For Each objItem In objStartFolder.Items
            For Each objAtmt In objItem.Attachments
                strFileName = strDestinationFolder & AddTimeStamp(objAtmt.FileName)
                objAtmt.SaveAsFile strFileName
                lngCount = lngCount + 1
            Next objAtmt
        Next objItem
    
    
        ' Show this message when Finished
        If lngCount > 0 Then
            MsgBox "You can find the files here: " & strDestinationFolder, vbInformation, "Finished!"
        Else
            MsgBox "Could not find any e-mail attachments in the selected folder", vbInformation, "Finished!"
        End If
    
    
    
    
        ' Error information
    Err_Handler:
        If Err.Number Then
            MsgBox "An unexpected error has occurred." _
             & vbCrLf & "Please note and report the following information." _
             & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
             & vbCrLf & "Error Number: " & Err.Number _
             & vbCrLf & "Error Description: " & Err.Description _
             , vbCritical, "Error!"
        End If
        
    ThisMacro_exit:
        'Clear memory
        Set objStartFolder = Nothing
        Set objSession = Nothing
        Set objApp = Nothing
        Set objAtmt = Nothing
        Set objItem = Nothing
        
    End Sub
    
    
    Function BrowseForFolder(Optional OpenAt As Variant) As Variant
         'Function purpose:  To Browser for a user selected folder.
         'If the "OpenAt" path is provided, open the browser at that directory
         'NOTE:  If invalid, it will open at the Desktop level
    
    
        Dim ShellApp As Object
    
    
         'Create a file browser window at the default folder
        Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    
    
         'Set the folder to that selected.  (On error in case cancelled)
        On Error Resume Next
        BrowseForFolder = ShellApp.self.Path
        On Error GoTo 0: On Error GoTo -1
    
    
         'Destroy the Shell Application
        Set ShellApp = Nothing
    
    
         'Check for invalid or non-entries and send to the Invalid error
         'handler if found
         'Valid selections can begin L: (where L is a letter) or
         '\\ (as in \\servername\sharename.  All others are invalid
        Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
        End Select
    
    
        Exit Function
    
    
    Invalid:
         'If it was determined that the selection was invalid, set to False
        BrowseForFolder = False
    End Function
    
    
    Function AddTimeStamp(strToWhat As String) As String
        
        AddTimeStamp = Mid(strToWhat, 1, InStrRev(strToWhat, ".") - 1) & "_" & Format(Now(), "yyyymmdd hhmmss.00") & "_" & Mid(strToWhat, InStrRev(strToWhat, "."))
        
    End Function
    
    
    
    
    'Purpose   :    Returns the UNC Path given a path
    'Inputs    :    sPathName           The path to convert
    'Outputs   :    The UNC path of sPathName
    'Notes     :    Requires NT/2000
    'Revisions :
    
    
    Function ConvertToUNC(sPathName As String) As String
    
    
        Dim szValue As String, szValueName As String, sUNCName As String
        Dim lErrCode As Long, lEndBuffer As Long
        Const lLenUNC As Long = 520
        'Return values for WNetGetConnection
        Const NO_ERROR As Long = 0
        Const ERROR_NOT_CONNECTED As Long = 2250
        Const ERROR_BAD_DEVICE = 1200&
        Const ERROR_MORE_DATA = 234
        Const ERROR_CONNECTION_UNAVAIL = 1201&
        Const ERROR_NO_NETWORK = 1222&
        Const ERROR_EXTENDED_ERROR = 1208&
        Const ERROR_NO_NET_OR_BAD_PATH = 1203&
    
    
        'Verify whether the disk is connected to the network
        If Mid$(sPathName, 2, 1) = ":" Then
            sUNCName = String$(lLenUNC, 0)
            lErrCode = WNetGetConnection(Left$(sPathName, 2), sUNCName, lLenUNC)
            lEndBuffer = InStr(sUNCName, vbNullChar) - 1
            'Can ignore the errors below (will still return the correct UNC)
            If lEndBuffer > 0 And (lErrCode = NO_ERROR Or lErrCode = ERROR_CONNECTION_UNAVAIL Or lErrCode = ERROR_NOT_CONNECTED) Then
                'Success
                sUNCName = Trim$(Left$(sUNCName, InStr(sUNCName, vbNullChar) - 1))
                ConvertToUNC = sUNCName & Mid$(sPathName, 3)
            Else
                'Error, return original path
                ConvertToUNC = sPathName
            End If
        Else
            'Already a UNC Path
            ConvertToUNC = sPathName
        End If
        
    End Function
    
    Ensured total continuity of IT services and managed cent percent issue resolution for desktop/laptop installations and trouble shooting at DCO and Chairman’s residence. Was accountable for the maintenance of all network components within area of work, and oversaw the installation, testing and evaluation of success of the installations. Ensured tight protection for deployment of all new computing devices and enterprise endpoints, and managed its security compliance. Provided 100% update of latest patch definition and antivirus file in all standalone computers. Handled escalations for unresolved incidents in coordination with HO. Ensured that the resident and visiting corporate senior users are provided with quick and immediate IT support, thereby ensuring more than 98% uptime for handheld devices. Maintained a high sense of documentation and incidence reporting, by ensuring that all calls related to corporate affairs users and IT assets are logged in the service desk tool.
    
    Ensured that all IT policy compliance activities are continued as per schedule by conducting periodic reviews of all standalone computers (desktops/laptos) at DCO and B-63 G.K-1, and kept the systems up-to-date by ensuring all endpoints have the latest versions of anti-virus , and MS hot-fixes and patches. Compiled and updated a quarterly list of assets inventory and software licenses and co-ordinated with MIS and HO for any license gaps. Conducted a detailed physical substantiation of IT assets on a half year basis.
    
    Ensured monitoring of system activity and performed auditing to maintain sufficient disk space and ensure file system integrity is maintained, thereby ensuring 100% uptime of the application without performance issues at user end. Addressed all day today activities like maintenance tasks, monitoring mail, print and other applications, installation, configuration and removal of software packages as required, install, mount and configure peripheral devices, manage new user creation, account unlock, password reset and application related queries. Ensured regular liaison and follow-up with the  ASG team for debugging and enhancements.
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://eileenslounge.com/viewtopic.php?p=318868#p318868
    https://eileenslounge.com/viewtopic.php?p=318311#p318311
    https://eileenslounge.com/viewtopic.php?p=318302#p318302
    https://eileenslounge.com/viewtopic.php?p=317704#p317704
    https://eileenslounge.com/viewtopic.php?p=317704#p317704
    https://eileenslounge.com/viewtopic.php?p=317857#p317857
    https://eileenslounge.com/viewtopic.php?p=317541#p317541
    https://eileenslounge.com/viewtopic.php?p=317520#p317520
    https://eileenslounge.com/viewtopic.php?p=317510#p317510
    https://eileenslounge.com/viewtopic.php?p=317547#p317547
    https://eileenslounge.com/viewtopic.php?p=317573#p317573
    https://eileenslounge.com/viewtopic.php?p=317574#p317574
    https://eileenslounge.com/viewtopic.php?p=317582#p317582
    https://eileenslounge.com/viewtopic.php?p=317583#p317583
    https://eileenslounge.com/viewtopic.php?p=317605#p317605
    https://eileenslounge.com/viewtopic.php?p=316935#p316935
    https://eileenslounge.com/viewtopic.php?p=317030#p317030
    https://eileenslounge.com/viewtopic.php?p=317030#p317030
    https://eileenslounge.com/viewtopic.php?p=317014#p317014
    https://eileenslounge.com/viewtopic.php?p=316940#p316940
    https://eileenslounge.com/viewtopic.php?p=316927#p316927
    https://eileenslounge.com/viewtopic.php?p=316875#p316875
    https://eileenslounge.com/viewtopic.php?p=316704#p316704
    https://eileenslounge.com/viewtopic.php?p=316412#p316412
    https://eileenslounge.com/viewtopic.php?p=316412#p316412
    https://eileenslounge.com/viewtopic.php?p=316254#p316254
    https://eileenslounge.com/viewtopic.php?p=316046#p316046
    https://eileenslounge.com/viewtopic.php?p=317050&sid=d7e077e50e904a138c794e1f2115da95#p317050
    https://www.youtube.com/@alanelston2330
    https://www.youtube.com/watch?v=yXaYszT11CA&lc=UgxEjo0Di9-9cnl8UnZ4AaABAg.9XYLEH1OwDIA35HNIei0z-
    https://eileenslounge.com/viewtopic.php?p=316154#p316154
    https://www.youtube.com/watch?v=TW3l7PkSPD4&lc=UgwAL_Jrv7yg7WWC8x14AaABAg
    https://teylyn.com/2017/03/21/dollarsigns/#comment-191
    https://eileenslounge.com/viewtopic.php?p=317050#p317050
    https://eileenslounge.com/viewtopic.php?f=27&t=40953&p=316854#p316854
    https://www.eileenslounge.com/viewtopic.php?v=27&t=40953&p=316875#p316875
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 07-25-2024 at 01:44 PM.

Similar Threads

  1. Testing Image Links
    By DocAElstein in forum Test Area
    Replies: 5
    Last Post: 04-19-2022, 01:57 PM
  2. Test
    By DocAElstein in forum Test Area
    Replies: 0
    Last Post: 03-30-2020, 07:20 PM
  3. test
    By EFmanagement in forum Test Area
    Replies: 0
    Last Post: 09-29-2019, 11:01 PM
  4. Test
    By Excel Fox in forum Word Help
    Replies: 0
    Last Post: 07-05-2011, 01:51 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •