Consulting

Results 1 to 8 of 8

Thread: Trouble posting a new thread

  1. #1
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location

    Trouble posting a new thread

    I am trying to post a new thread to the "Outlook Help" forum.

    When I try to post the thread, I get the following error: "Post denied. New posts are limited by number of URLs it may contain and checked if it doesn't contain forbidden words."

    I am trying to post some VBA code surrounded by the Code tags.

    Does anyone know what the issue is?

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Posts
    8,028
    Location
    Put the entire text in a txt file exactly the way you're trying, zip that, and attach to this thread
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location
    Paul,

    Here is the ZIP file.

    I am trying to get help with the code included.

    I keep getting a runtime error.

    Code.zip

    Thank you,

    Brian

  4. #4
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    3,898
    Location
    Here's your code LVGBR

    Option Explicit
     
    Sub SaveAllEmails_ProcessAllSubFolders()
    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim StrSubject As String
    Dim StrName As String
    Dim StrFile As String
    Dim StrReceived As String
    Dim StrSavePath As String
    Dim StrFolder As String
    Dim StrFolderPath As String
    Dim StrSaveFolder As String
    Dim Prompt As String
    Dim Title As String
    Dim iNameSpace As NameSpace
    Dim myOlApp As Outlook.Application
    Dim SubFolder As MAPIFolder
    Dim mItem As MailItem
    Dim FSO As Object
    Dim ChosenFolder As Object
    Dim Folders As New Collection
    Dim EntryID As New Collection
    Dim StoreID As New Collection
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myOlApp = Outlook.Application
    Set iNameSpace = myOlApp.GetNamespace("MAPI")
    Set ChosenFolder = iNameSpace.PickFolder
    If ChosenFolder Is Nothing Then
    GoTo ExitSub:
    End If
    Prompt = "Please enter the path to save all the emails to."
    Title = "Folder Specification"
    StrSavePath = BrowseForFolder
    If StrSavePath = "" Then
    GoTo ExitSub:
    End If
    If Not Right(StrSavePath, 1) = "\" Then
    StrSavePath = StrSavePath & "\"
    End If
    Call GetFolder(Folders, EntryID, StoreID, ChosenFolder)
    For i = 1 To Folders.Count
    StrFolder = StripIllegalChar(Folders(i))
    n = InStr(3, StrFolder, "\") + 1
    StrFolder = Mid(StrFolder, n, 256)
    StrFolderPath = StrSavePath & StrFolder & "\"
    StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\"
    If Not FSO.FolderExists(StrFolderPath) Then
    FSO.CreateFolder (StrFolderPath)
    End If
    Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
    On Error Resume Next
    For j = 1 To SubFolder.Items.Count
    Set mItem = SubFolder.Items(j)
    StrReceived = ArrangedDate(mItem.ReceivedTime)
    StrSubject = mItem.Subject
    StrName = StripIllegalChar(StrSubject)
    StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg"
    StrFile = Left(StrFile, 256)
    mItem.SaveAs StrFile, 3
    Next j
    On Error GoTo 0
    Next i
    ExitSub:
    End Sub
     
    Function StripIllegalChar(StrInput)
    Dim RegX As Object
    Set RegX = CreateObject("vbscript.regexp")
    RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
    RegX.IgnoreCase = True
    RegX.Global = True
    StripIllegalChar = RegX.Replace(StrInput, "")
    ExitFunction:
    Set RegX = Nothing
    End Function
     
     
    Function ArrangedDate(StrDateInput)
    Dim StrFullDate As String
    Dim StrFullTime As String
    Dim StrAMPM As String
    Dim StrTime As String
    Dim StrYear As String
    Dim StrMonthDay As String
    Dim StrMonth As String
    Dim StrDay As String
    Dim StrDate As String
    Dim StrDateTime As String
    Dim RegX As Object
    Set RegX = CreateObject("vbscript.regexp")
    If Not Left(StrDateInput, 2) = "10" And _
    Not Left(StrDateInput, 2) = "11" And _
    Not Left(StrDateInput, 2) = "12" Then
    StrDateInput = "0" & StrDateInput
    End If
    StrFullDate = Left(StrDateInput, 10)
    If Right(StrFullDate, 1) = " " Then
    StrFullDate = Left(StrDateInput, 9)
    End If
    StrFullTime = Replace(StrDateInput, StrFullDate & " ", "")
    If Len(StrFullTime) = 10 Then
    StrFullTime = "0" & StrFullTime
    End If
    StrAMPM = Right(StrFullTime, 2)
    StrTime = StrAMPM & "-" & Left(StrFullTime, 8)
    StrYear = Right(StrFullDate, 4)
    StrMonthDay = Replace(StrFullDate, "/" & StrYear, "")
    StrMonth = Left(StrMonthDay, 2)
    StrDay = Right(StrMonthDay, Len(StrMonthDay) - 3)
    If Len(StrDay) = 1 Then
    StrDay = "0" & StrDay
    End If
    StrDate = StrYear & "-" & StrMonth & "-" & StrDay
    StrDateTime = StrDate & "_" & StrTime
    RegX.Pattern = "[\:\/\ ]"
    RegX.IgnoreCase = True
    RegX.Global = True
    ArrangedDate = RegX.Replace(StrDateTime, "-")
    ExitFunction:
    Set RegX = Nothing
    End Function
     
    Sub GetFolder(Folders As Collection, EntryID As Collection, StoreID As Collection, Fld As MAPIFolder)
    Dim SubFolder As MAPIFolder
    Folders.Add Fld.FolderPath
    EntryID.Add Fld.EntryID
    StoreID.Add Fld.StoreID
    For Each SubFolder In Fld.Folders
    GetFolder Folders, EntryID, StoreID, SubFolder
    Next SubFolder
    ExitSub:
    Set SubFolder = Nothing
    End Sub
     
    Function BrowseForFolder(Optional OpenAt As String) As String
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
    If Left(BrowseForFolder, 1) = ":" Then
    BrowseForFolder = ""
    End If
    Case Is = "\"
    If Not Left(BrowseForFolder, 1) = "\" Then
    BrowseForFolder = ""
    End If
    Case Else
    BrowseForFolder = ""
    End Select
    ExitFunction:
    Set ShellApp = Nothing
    End Function
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    VBAX Newbie
    Joined
    Oct 2021
    Posts
    4
    Location
    How do I post the code inside the code tags in the appropriate forum without getting the "Post Denied" error?

    I want to be able to post the code, then reference the part of the code that gives me the run-time error to see if someone has some thoughts on how to tweak the code.

    Thank you.

  6. #6
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    3,898
    Location
    Not sure why you are having issues posting. Go to the Test sub forum and try posting small amounts of code. To wrap within the correct tags simply highlight your supplied code and click the Hash Tag icon
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Posts
    8,028
    Location
    1 looked through your txt file and nothing jumps out me either

    I pasted the code in CODE tags and there were no issues

    Maybe just trying a sub or function at a time to see if there's something hinky in a line
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    add a Breakpoint on your sub and try to debug it.

Posting Permissions

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