Some useful vba macros

1. Save attachements from multiple emails to a directory (Outlook):
Public Sub SaveAttachments()
    Dim SaveToPath As String
    SaveToPath = "C:\temp\"
    Set myfolder = Application.ActiveExplorer.CurrentFolder
    For Each myitem In myfolder.Items
        For Each myattachment In myitem.Attachments
            myattachment.SaveAsFile SaveToPath & myattachment.FileName
        Next
    Next
    MsgBox "All attachements in "& myfolder.FolderPath & " have been saved to " & SaveToPath
End Sub

2. Convert all xls files in a directory to csv files (Excel) (from http://jointtech.com/today-a-client-asked/xls-csv-convert):

Option Explicit
Sub testme01()

    Application.ScreenUpdating = False

    Dim myFiles() As String
    Dim fCtr As Long
    Dim myFile As String
    Dim myPath As String
    Dim tempWkbk As Workbook
    Dim logWks As Worksheet
    Dim tempName As String
    Dim wks As Worksheet
    Dim oRow As Long

    'change to point at the folder to check
    myPath = "D:\My Documents\john"
    If Right(myPath, 1) <> "\" Then
        myPath = myPath & "\"
    End If

    myFile = Dir(myPath & "*.xls")
    If myFile = "" Then
        MsgBox "no files found"
        Exit Sub
    End If

    Set logWks = Workbooks.Add(1).Worksheets(1)
    logWks.Range("a1").Resize(1, 3).Value _
        = Array("WkbkName", "WkSheetName", "CSV Name")

    'get the list of files
    fCtr = 0
    Do While myFile <> ""
        fCtr = fCtr + 1
        ReDim Preserve myFiles(1 To fCtr)
        myFiles(fCtr) = myFile
        myFile = Dir()
    Loop

    If fCtr > 0 Then
        oRow = 1
        For fCtr = LBound(myFiles) To UBound(myFiles)
            Set tempWkbk = Nothing
            On Error Resume Next
            Set tempWkbk = Workbooks.Open(Filename:=myPath & myFiles(fCtr))
            On Error GoTo 0
            If tempWkbk Is Nothing Then
                logWks.Cells(oRow, "A").Value = "Error Opening: " _
                                                      & myFiles(fCtr)
                oRow = oRow + 1
            Else
                For Each wks In tempWkbk.Worksheets
                    With wks
                        If Application.CountA(.UsedRange) = 0 Then
                            'do nothing
                        Else
                            .Copy 'to a new workbook
                            tempName = myPath & Left(myFiles(fCtr), Len(myFiles(fCtr)) - 4) & "." & Trim(.Name) & ".csv"
                            Do
                                If Dir(tempName) = "" Then
                                    Exit Do
                                Else
                                    tempName = myPath & Trim(.Name) & "_" _
                                          & Format(Time, "hhmmss") & ".csv"
                                End If
                            Loop
                            oRow = oRow + 1
                            With ActiveWorkbook
                                .SaveAs Filename:=tempName, FileFormat:=xlCSV
                                .Close savechanges:=False
                            End With
                            logWks.Cells(oRow, "A").Value = myFiles(fCtr)
                            logWks.Cells(oRow, "b").Value = .Name
                            logWks.Cells(oRow, "C").Value = tempName
                        End If
                    End With
                Next wks
                tempWkbk.Close savechanges:=False
            End If
        Next fCtr
    End If

    With logWks.UsedRange
        .AutoFilter
        .Columns.AutoFit
    End With

    Application.ScreenUpdating = True

End Sub