Primer valor no vacio de un rango

Esta función nos permite encontrar el primer valor distinto a vacío en un rango y nos devuelve su valor

Public Function Primero(Rango As Range) As Variant
    'devuelve el primer valor no vacio de un rango
    'abelorteu@informaticaea.com
 
    Dim obj_Cell As Range
    'Recorremos las celdas del rango seleccionado en busca de un valor no blanco
    For Each obj_Cell In Rango.Cells
        If obj_Cell.Text <> "" Then
            Primero = obj_Cell.Text 'Encontrado el primer valor
            Exit For 'Escapamos del FOR
        End If
    Next
End Function

MaxArrSiConjunto

Esta función nos permite obtener el valor máximo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor máximo del rango. La particularidad de esta función es que te permite acceder al valor máximo (primer máximo, segundo máximo, tercer máximo)

=MaxArrSiConjunto([1];[2];[3′];[4′];[3”];[4”]…..)

[1]: Rango de valores que queremos encontrar el valor máximo

[2]: Posición del array (1: pirmer máximo, 2: segundo máximo….)

[3′]: Rango que tienen las condiciones

[4′]: Condición

[3”]: Segundo Rango que tienen las condiciones

[4”]: Segunda Condición

…… Tantos rangos y condiciones como quieras

Public Function MaxArrSiConjunto(Unico As Range, Pos As Integer, ParamArray prms() As Variant) As Variant
    '=MaxSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2]: Posición del array (1: pirmer máximo, 2: segundo máximo....)
       '[3']: Rango que tienen las condiciones
       '[4']: Condición
       '[5'']: Segundo Rango que tienen las condiciones
       '[6'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim i As Integer
 
    Dim col As New Collection
    Dim colSort As New Collection
    Dim varElement As Variant
 
    filaInit = Unico.Row
    filaFinal = filaInit + Unico.Count - 1
 
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    If (x = Int(x)) Then
        On Error Resume Next
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If (Condicion) Then
                col.Add Item:=CStr(CLng(Unico(i))), Key:=CStr(CLng(Unico(i)))
            End If
        Next i
 
        Set colSort = fnVarBubbleSort(col, False)
 
        i = 1
        MaxArrSiConjunto = "#NoValue"
        For Each varElement In colSort
            If i = Pos Then
                'Debug.Print varElement
                MaxArrSiConjunto = CLng(varElement)
            End If
            i = i + 1
        Next varElement
    Else
       MaxArrSiConjunto = "#ERROR"
    End If
End Function
 
Public Function fnVarBubbleSort(ByRef colInput As Collection, Optional bAsc = True) As Collection
 
    Dim varTemp                 As Variant
    Dim lngCounter              As Long
    Dim lngCounter2             As Long
 
    For lngCounter = 1 To colInput.Count - 1
        For lngCounter2 = lngCounter + 1 To colInput.Count
            Select Case bAsc
            Case True:
                If colInput(lngCounter) > colInput(lngCounter2) Then
                    varTemp = colInput(lngCounter2)
                    colInput.Remove lngCounter2
                    colInput.Add varTemp, varTemp, lngCounter
                End If
 
            Case False:
                If colInput(lngCounter) < colInput(lngCounter2) Then
                    varTemp = colInput(lngCounter2)
                    colInput.Remove lngCounter2
                    colInput.Add varTemp, varTemp, lngCounter
                End If
            End Select
        Next lngCounter2
    Next lngCounter
 
    Set fnVarBubbleSort = colInput
 
End Function

MaxSiConjunto

Esta función nos permite obtener el valor máximo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor máximo del rango.

=MaxSiConjunto([1];[2′];[3′];[2”];[3”]…..)

[1]: Rango de valores que queremos encontrar el valor máximo/p>

[2′]: Rango que tienen las condiciones

[3′]: Condición

[2”]: Segundo Rango que tienen las condiciones

[3”]: Segunda Condición ‘…… Tantos rangos y condiciones como quieras

Public Function MaxSiConjunto(ValMax As Range, ParamArray prms() As Variant) As Variant
 
    '=MaxSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos encontrar el valor máximo
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
 
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim MAX As Variant
 
 
    filaInit = ValMax.Row
    filaFinal = filaInit + ValMax.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    MAX = "#ERROR"
    If (x = Int(x)) Then
        On Error Resume Next
        MAX = "#ERROR"
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If Condicion Then
                If (CLng(ValMax(i)) > CLng(MAX)) Then
                    MAX = CLng(ValMax(i))
                End If
            End If
        Next i
    End If
    MaxSiConjunto = MAX
End Function

MinSiConjunto

Esta función nos permite obtener el valor mínimo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor mínimo del rango.

=MinSiConjunto([1];[2′];[3′];[2”];[3”]…..)

[1]: Rango de valores que queremos encontrar el valor mínimo

[2′]: Rango que tienen las condiciones

[3′]: Condición

[2”]: Segundo Rango que tienen las condiciones

[3”]: Segunda Condición ‘…… Tantos rangos y condiciones como quieras

Public Function MinSiConjunto(ValMin As Range, ParamArray prms() As Variant) As Variant
    '=MinSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos encontrar el valor minimo
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
 
 
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim MIN As Variant
 
 
    filaInit = ValMin.Row
    filaFinal = filaInit + ValMin.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    MIN = "#ERROR"
    If (x = Int(x)) Then
        On Error Resume Next
        MIN = "#ERROR"
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If Condicion Then
                If (CLng(ValMin(i)) < CLng(MIN)) Then
                    MIN = CLng(ValMin(i))
                End If
            End If
        Next i
    End If
    MinSiConjunto = MIN
End Function

Collection VBA

Los tipos de datos Collection en algunos libros de informática se denominan diccionario que es una tabla de elementos en la que puedes buscar una entrada usando una clave.

En Visual Basic los datos Collection. Presentan las siguientes características:

  • Habilita almacenar elementos relacionados
  • Proporciona los métodos Add, Remove, Item y la propiedad Count
Dim dict As New Collection
 
dict.Add Item:="Valor 1", Key:="Key 1"
dict.Add Item:="Valor 2", Key:="Key 2"
dict.Add Item:="Valor 3", Key:="Key 3"
dict.Add Item:="Valor 4", Key:="Key 4"

Si queremos acceder a un elemento a partir de la clave

Debug.Print (dict("Key 2"))
'Valor 2

Si queremos listar toda la matriz

Dim K As Variant
For Each K In dict.Keys
    debug.print "Key: " &amp; K , "Value: " &amp; dict.Item(K)
Next

Pegar imagen en una celda

Para pegar una imagen que tenemos en el porta papeles en una celda de Excel seleccionada, utilizaremos la siguiente macro:

Sub PegarFoto()
    ActiveSheet.Paste 'Pegamos del portapapeles
    ActiveSheet.Select
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 175 'Alto de la imagen
        .ShapeRange.Width = 205 'Ancho de la imagen
        .ShapeRange.Left = .ShapeRange.Left + 1 'Añadimos 1 para que se vea la línea divisoria de la celda (izquierda)
        .ShapeRange.Top = .ShapeRange.Top + 1 'Añadimos 1 para que se vea la línea divisoria de la celda (superior)
    End With
End Sub

Obtener la letra de una columna en Excel

Esta fórmula nos permite obtener el valor de la columna:

=SUSTITUIR(SUSTITUIR(DIRECCION(FILA();COLUMNA());"$";"");FILA();"")

Explicación de las formulas empleadas:

  • SUSTITUIR: con esta reemplazamos, realmente eliminamos, caracteres que nos estorban para nuestro objetivo
  • DIRECCION: definimos la celda a evaluar, para obtener de ella la letra de su columna.
  • FILA y COLUMNA: la base de toda la propuesta, con éstas obtenemos una numeración para definir una celda.

Desactivar las animaciones de Office

Office 2013 es la primera versión para utilizar la aceleración de hardware en toda la experiencia del usuario para reproducir animaciones bonitas, fluidos. Sin embargo, si utiliza el equipo sin una pantalla o simplemente prefiere eliminar animaciones innecesarias para no consumir tantos recursos del sistema, tiene la opción de desactivarlos.

Para desactivar las animaciones Office:

  1. Abra el centro de accesibilidad presionando la tecla del logotipo de Windows + U.
  2. En Explorar toda la configuración, haga clic en Usar el equipo sin una pantalla.
  3. En Ajustar los límites de tiempo y los efectos visuales intermitentes, haga clic en Desactivar todas las animaciones no necesarias (cuando sea posible).
  4. Haga clic en Aceptar.

Desactivar animaciones

Tabla de traducción de fórmulas Excel español vs english

Español Inglés
ABRIR.ARCHIVO OPEN.DIALOG
ABRIRA FOPEN
ABS ABS
ACOS ACOS
ACOSH ACOSH
AGREGAR.BARRA ADD.BAR
AGREGAR.BARRA.HERRAMIENTAS ADD.TOOLBAR
AGREGAR.COMANDO ADD.COMMAND
AGREGAR.MENU ADD.MENU
AGRUPAR GROUP
AHORA NOW
ALEATORIO RAND
AÑO YEAR
APL.TITULO APP.TITLE
ARCHIVOS FILES
AREAS AREAS
ARGUMENTO ARGUMENT
ASC ASC
ASENO ASIN
ASENOH ASINH
ATAN ATAN
ATAN2 ATAN2
ATANH ATANH
AYUDA HELP
BDCONTAR DCOUNT
BDCONTARA DCOUNTA
BDDESVEST DSTDEV
BDDESVESTP DSTDEVP
BDEXTRAER DGET
BDMAX DMAX
BDMIN DMIN
BDPRODUCTO DPRODUCT
BDPROMEDIO DAVERAGE
BDSUMA DSUM
BDVAR DVAR
BDVARP DVARP
BINOM.CRIT CRITBINOM
BUSCAR LOOKUP
BUSCARH HLOOKUP
BUSCARV VLOOKUP
CADENA.FECHA DATESTRING
CADENA.NUMERO NUMBERSTRING
CAMBIAR.NOMBRE.COMANDO RENAME.COMMAND
CANCELAR.TECLA CANCEL.KEY
CARACTER CHAR
CELDA CELL
CELDA.ACTIVA ACTIVE.CELL
CERRARA FCLOSE
CODIGO CODE
COEF.DE.CORREL CORREL
COEFICIENTE.ASIMETRIA SKEW
COEFICIENTE.R2 RSQ
COINCIDIR MATCH
COLUMNA COLUMN
COLUMNAS COLUMNS
COMBINAT COMBIN
CONCATENAR CONCATENATE
CONTAR COUNT
CONTAR.BLANCO COUNTBLANK
CONTAR.SI COUNTIF
CONTARA COUNTA
COS COS
COSH COSH
COVAR COVAR
CREAR.OBJETO CREATE.OBJECT
CRECIMIENTO GROWTH
CUADRO.DE.DIALOGO DIALOG.BOX
CUADRO.DE.TEXTO TEXT.BOX
CUARTIL QUARTILE
CURTOSIS KURT
DB DB
DBCS DBCS
DDB DDB
DECIMAL FIXED
DERECHA RIGHT
DERECHAB RIGHTB
DESREF OFFSET
DESREGISTRAR UNREGISTER
DESVEST STDEV
DESVESTP STDEVP
DESVIA2 DEVSQ
DESVPROM AVEDEV
DETENER HALT
DIA DAY
DIAS360 DAYS360
DIASEM WEEKDAY
DIRECCION ADDRESS
DIRECTORIO DIRECTORY
DIST.WEIBULL WEIBULL
DISTR.BETA BETADIST
DISTR.BETA.INV BETAINV
DISTR.BINOM BINOMDIST
DISTR.CHI CHIDIST
DISTR.EXP EXPONDIST
DISTR.F FDIST
DISTR.F.INV FINV
DISTR.GAMMA GAMMADIST
DISTR.GAMMA.INV GAMMAINV
DISTR.HIPERGEOM HYPGEOMDIST
DISTR.LOG.INV LOGINV
DISTR.LOG.NORM LOGNORMDIST
DISTR.NORM NORMDIST
DISTR.NORM.ESTAND NORMSDIST
DISTR.NORM.ESTAND.INV NORMSINV
DISTR.NORM.INV NORMINV
DISTR.T TDIST
DISTR.T.INV TINV
DOCUMENTOS DOCUMENTS
DVS VDB
ECHO ECHO
EJEC EXEC
EJECUTA EXECUTE
ELEGIR CHOOSE
ELIMINAR.BARRA DELETE.BAR
ELIMINAR.BARRA.HERRAMIENTAS DELETE.TOOLBAR
ELIMINAR.COMANDO DELETE.COMMAND
ELIMINAR.MENU DELETE.MENU
ENCONTRAR FIND
ENCONTRARB FINDB
ENTERO INT
ERROR ERROR
ERROR.TIPICO.XY STEYX
ESBLANCO ISBLANK
ESCENARIO.INDICAR SCENARIO.GET
ESCRIBIRA FWRITE
ESCRIBIRALN FWRITELN
ESERR ISERR
ESERROR ISERROR
ESLOGICO ISLOGICAL
ESNOD ISNA
ESNOTEXTO ISNONTEXT
ESNUMERO ISNUMBER
ESPACIOS TRIM
ESREF ISREF
ESTABLECER.NOMBRE SET.NAME
ESTABLECER.VALOR SET.VALUE
ESTEXTO ISTEXT
ESTIMACION.LINEAL LINEST
ESTIMACION.LOGARITMICA LOGEST
EVALUAR EVALUATE
EXP EXP
EXTRAE MIDB
EXTRAE MID
FACT FACT
FECHA DATE
FECHANUMERO DATEVALUE
FILA ROW
FILAS ROWS
FISHER FISHER
FORMULA.CONVERTIR FORMULA.CONVERT
FRECUENCIA FREQUENCY
GAMMA.LN GAMMALN
GET.MOVIE GET.MOVIE
GRADOS DEGREES
GUARDAR.ARCHIVO SAVE.DIALOG
GUARDAR.BARRA.HERRAMIENTAS SAVE.TOOLBAR
HABILITAR.COMANDO ENABLE.COMMAND
HABILITAR.HERRAMIENTA ENABLE.TOOL
HALLAR SEARCH
HALLARB SEARCHB
HORA HOUR
HORANUMERO TIMEVALUE
HOY TODAY
ID.REGISTRO REGISTER.ID
IGUAL EXACT
INDICAR.AREA.DE.TRABAJO GET.WORKSPACE
INDICAR.BARRA GET.BAR
INDICAR.BARRA.HERRAMIENTAS GET.TOOLBAR
INDICAR.CAMPO.TABLA.DI GET.PIVOT.FIELD
INDICAR.CELDA GET.CELL
INDICAR.DEF GET.DEF
INDICAR.DOCUMENTO GET.DOCUMENT
INDICAR.ELEMENTO.GRAFICO GET.CHART.ITEM
INDICAR.ELEMENTO.TABLA.DI GET.PIVOT.ITEM
INDICAR.FORMULA GET.FORMULA
INDICAR.HERRAMIENTA GET.TOOL
INDICAR.INFO.VINCULO GET.LINK.INFO
INDICAR.LIBRO GET.WORKBOOK
INDICAR.NOMBRE GET.NAME
INDICAR.NOTAS GET.NOTE
INDICAR.OBJETO GET.OBJECT
INDICAR.TABLA.DINAMICA GET.PIVOT.TABLE
INDICAR.VENTANA GET.WINDOW
INDICE INDEX
INDIRECTO INDIRECT
INFO INFO
INICIAR INITIATE
INT.PAGO.DIR ISPMT
INTERSECCION INTERCEPT
INTERVALO.CONFIANZA CONFIDENCE
INTRODUCIR INPUT
IR.A GOTO
IZQUIERDA LEFT
IZQUIERDAB LEFTB
JERARQUIA RANK
K.ESIMO.MAYOR LARGE
K.ESIMO.MENOR SMALL
LARGO LEN
LARGOB LENB
LEERA FREAD
LEERALN FREADLN
LIMPIAR CLEAN
LN LN
LOG LOG
LOG10 LOG10
LLAMADOR CALLER
LLAMAR CALL
MARCAR.COMANDO CHECK.COMMAND
MAX MAX
MAYUSC UPPER
MDETERM MDETERM
MEDIA.ACOTADA TRIMMEAN
MEDIA.ARMO HARMEAN
MEDIA.GEOM GEOMEAN
MEDIANA MEDIAN
MES MONTH
MIN MIN
MINUSC LOWER
MINUTO MINUTE
MINVERSA MINVERSE
MMULT MMULT
MODA MODE
MONEDA DOLLAR
MOSTRAR.BARRA SHOW.BAR
MOVIE.COMMAND MOVIE.COMMAND
MULTIPLO.INFERIOR FLOOR
MULTIPLO.SUPERIOR CEILING
N N
NEGBINOMDIST NEGBINOMDIST
NO NOT
NOD NA
NOMBRES NAMES
NOMPROPIO PROPER
NORMALIZACION STANDARDIZE
NOTA NOTE
NPER NPER
NSHORA TIME
NUMERO.ROMANO ROMAN
O OR
OPCIONES.INDICAR.LISTAS OPTIONS.LISTS.GET
PAGO PMT
PAGOINT IPMT
PAGOPRIN PPMT
PASO.A.PASO STEP
PAUSA PAUSE
PEARSON PEARSON
PENDIENTE SLOPE
PERCENTIL PERCENTILE
PERMUTACIONES PERMUT
PERSONALIZAR.DESHACER CUSTOM.UNDO
PERSONALIZAR.REPETIR CUSTOM.REPEAT
PI PI
POISSON POISSON
POSICIONA FPOS
POTENCIA POWER
PRESIONAR.HERRAMIENTA PRESS.TOOL
PROBABILIDAD PROB
PRODUCTO PRODUCT
PROMEDIO AVERAGE
PRONOSTICO FORECAST
PRUEBA.CHI CHITEST
PRUEBA.CHI.INV CHIINV
PRUEBA.F FTEST
PRUEBA.FISHER.INV FISHERINV
PRUEBA.T TTEST
PRUEBA.Z ZTEST
RADIANES RADIANS
RAIZ SQRT
RANGO.PERCENTIL PERCENTRANK
REANUDAR RESUME
REDONDEA.IMPAR ODD
REDONDEA.PAR EVEN
REDONDEAR ROUND
REDONDEAR.MAS ROUNDUP
REDONDEAR.MENOS ROUNDDOWN
REEMPLAZAR REPLACE
REEMPLAZARB REPLACEB
REFABS ABSREF
REFREL RELREF
REFTEXTO REFTEXT
REGISTRAR REGISTER
REINICIAR RESTART
REPETIR REPT
RESIDUO MOD
RESTABLECER.BARRA RESET.TOOLBAR
RESULTADO RESULT
REVISION.ORTOGRAFICA SPELLING.CHECK
SEGUNDO SECOND
SELECCION SELECTION
SENO SIN
SENOH SINH
SERIES SERIES
SI IF
SIFECHA DATEDIF
SIGNO SIGN
SLN SLN
SOLICITAR REQUEST
SUBTOTALES SUBTOTAL
SUMA SUM
SUMA.CUADRADOS SUMSQ
SUMAPRODUCTO SUMPRODUCT
SUMAR.SI SUMIF
SUMAX2MASY2 SUMX2PY2
SUMAX2MENOSY2 SUMX2MY2
SUMAXMENOSY2 SUMXMY2
SUSTITUIR SUBSTITUTE
SYD SYD
T T
TABLA.DI.ADICIONAR.DATOS PIVOT.ADD.DATA
TAMAÑOA FSIZE
TAN TAN
TANH TANH
TASA RATE
TENDENCIA TREND
TERMINAR TERMINATE
TEXTO TEXT
TEXTOREF TEXTREF
TIPO TYPE
TIPO.DE.ERROR ERROR.TYPE
TIR IRR
TIRM MIRR
TRANSFERIR POKE
TRANSPONER TRANSPOSE
TRUNCAR TRUNC
ULTIMO.ERROR LAST.ERROR
USDOLLAR USDOLLAR
VA PV
VALOR VALUE
VALREF DEREF
VAR VAR
VARP VARP
VENTANA.TITULO WINDOW.TITLE
VENTANAS WINDOWS
VF FV
VINCULOS LINKS
VNA NPV
VOLATIL VOLATILE
Y AND
FALSO FALSE
VERDADERO TRUE

 

Descargar archivos adjuntos correo

Outlook tiene la opción de descargar todos los archivos adjuntos de un correo, pero no se puede hacer de una selección de correos.

Podemos :

Sub DescargarArchivos()
    Dim adjunto As Attachment
    Dim Ruta As String
    Dim NombreArchivo As String
    Dim i As Integer
    Dim seleccion As Outlook.MailItem
    Ruta = BrowseForFolder("C:/")
    For Each seleccion In Application.ActiveExplorer.Selection
        For Each adjunto In seleccion.Attachments
            'filtramos sólo los archivos con extensión excel, este condicional se puede quitar o añadir extensiones
            If ((InStr(adjunto.DisplayName, ".xlsb") Or InStr(adjunto.DisplayName, ".xlsx") Or InStr(adjunto.DisplayName, ".xls") Or InStr(adjunto.DisplayName, ".xlsm"))) Then
                NombreArchivo = Ruta &amp; adjunto.FileName
                adjunto.SaveAsFile NombreArchivo
            End If
        Next adjunto
    Next seleccion
End Sub
 
 
Function BrowseForFolder(strStartingFolder As Variant) As String
    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = 0
    Dim objShell As Object, _
        objFolder As Object, _
        objFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, strStartingFolder)
    If Not TypeName(objFolder) = "Nothing" Then
        Set objFolderItem = objFolder.self
        BrowseForFolder = objFolderItem.Path &amp; "\"
    Else
        BrowseForFolder = ""
    End If
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function

Para crear un Script:

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Users\"
     For Each objAtt In itm.Attachments
          objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
          Set objAtt = Nothing
     Next
End Sub