Agregar o extender codigo para deteccion de arquitectura deso

[JoaoM]

Hola amigos.

Mi solicitud se basa en el código integrado en este libro, pueda Detectar si el sistema es de Arquitectura x86 o x64 y según la arquitectura, crie un archivo para dicha arquitectura.

Como está, cría el archivo SOLO para x86

Adjunto ZIP con el libro y además algunos archivos para que TODO su contenido sea colocado en una carpeta independiente y desde ahí sea ejecutado el código existente para que pueda(n) ver cómo funciona y el interior del archivo creado que se llamará Registro Librerias_2.cmd.

Agradezco desde ya su colaboración.

Dentro del libro en Hoja Solicitud, tengo la solicitud más corta y más explícita (creo)

1.part1.rar

1.part2.rar

1.part3.rar

1.part4.rar

[AlexanderS]

Hola [uSER=53155]@JoaoM[/uSER]

Aquí esta este mismo tema en discusión http://www.todoexpertos.com/preguntas/5giu7sdfb6di364h/editar-o-codigo-vba-excel-para-agregar-funcion?selectedanswerid=5gshu4diuv3nvo3m

Creo que ahí el amigo Valero respondió a tu pregunta por lo que seria bueno que primero le respondas a el ya que por lo que veo te ayudo con un código funcional, ademas de unos buenos consejos.Seria bueno que indiques si te funciono la ayuda proporcionada en el otro foro.

Salu2

[JoaoM]

Pues no. No me ha funcionado, parece que apesar de lo escrito, no ha entendido lo que pretendo.

Por ese motivo vine hacia acá.

Funciona pero no como quiero y pretendo si prefieres baja el libro y su contenido y verás en la Hoja Solicitud lo que pretendo.

NO es cosa de dejar aqui y alla un pedid de solucion, si no porque repito, perece que no me ha entendido en mi solicitud.

Si me hubiera funcionado, me hubiera quedado alla y por lo visto voy a calificarlo y dejar de seguir ese tema.

Puedes verificar que segun los mensages dejados por mi, que no me ha funcionado

[JoaoM]

Amigo Riddle, en el codigo del libro, ¿donde puedo quitar C:\0\1\ de las lineas creadas e nel archivo?

%systemroot%\SysWOW64\Regsvr32.exe C:\0\1\comctl32.dll

%systemroot%\SysWOW64\Regsvr32.exe C:\0\1\mscomct2.ocx

para que de solo esto

%systemroot%\SysWOW64\Regsvr32.exe nombre.ocx

en cada linea creada.

Eso nada mas me queda para resolver.

EStuve dando vueltas al codigo que tu dices me resovio en todoexpertos pero no, y no doy con el resultado.

Si me puedes dar una manita por ahí

Gracias.

[AlexanderS]

Apenas tenga tiempo reviso en mi casa que el SO es x64 porque aquí en mi trabajo estoy con un x86.

[rolano]

Hola JoaoM en google busca detectar x64 vba, pueda que te de una idea.

http://leandroascierto.com/foro/index.php?topic=511.0

http://stackoverflow.com/questions/6256140/how-to-detect-if-the-computer-is-x32-or-x64

[JoaoM]

Ok amigo, te lo agradezco.

Quiero mensionarte que mi mensage anterior, esta mal pues el libro que subi creo ser el que tiene el codigo original y no el que trato de acomodarme el amigo Valerio.

¿cual la diferencia de uno a otro? es que me dejo el amigo Valerio la diferencia es esta de uno a otro

Origen

Private Sub CreoBath()

Dim a As String

Dim b As String

Dim c As String

Dim i As Long

Dim fold As Variant

Dim fc As Variant

Dim f As Variant

Dim xtx As String

Erase archivos

a = "Regsvr32.exe "

b = ThisWorkbook.Path & Application.PathSeparator & "Registro librerias.cmd"

On Error Resume Next

Cambio

Sub CreoBath()

  Dim a  As String

  Dim b  As String

  Dim c  As String

  Dim i  As Long

  Dim fold  As Variant

  Dim fc  As Variant

  Dim f  As Variant

  Dim xtx  As String

  Erase archivos

  If Is64bit Then

  a = "%systemroot%\SysWOW64\Regsvr32.exe "

  Else

  a = "%systemroot%\System32\Regsvr32.exe "

  End If

  b = ThisWorkbook.Path & Application.PathSeparator & "Registro librerias.cmd" 'era Registrante.bat

  'On Error Resume Next

[/CODE]

Con el cambio si pero me coloca como dije arriba mas esto [b][color=#b30000]C:\0\1 [/color][/b]que está demas

Al desactivar o eliminar la linea On Error Resume Next si pisas cerrar en la ventana para buscar la carpeta donde se encuentran los archivos (librerias) para meter su nombre en el archivo, te acusa error

Alguna interrugante, avisa

Gracias

[rolano]

Hola JoaoM, he corrido el codigo y me registra esto

%systemroot%\SysWOW64\Regsvr32.exe C:\Users\e226528\Downloads\Excel\New folder\comctl32.dll

%systemroot%\SysWOW64\Regsvr32.exe C:\Users\e226528\Downloads\Excel\New folder\mscomct2.ocx


[/CODE]

[JoaoM]

Hola rolano

No se que codigo ejecutaste porque ninguno me registra eso.

Ejecutalo tal como dice la hoja Crear o Hoja1, creo es Crear su nombre. Dejo acá el codigo completo que ya tengo.

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProc As Long, bWow64Process As Boolean) As Long

Option Explicit

Dim archivos()

Public Function Is64bit() As Boolean

    Dim handle As Long, bolFunc As Boolean

    bolFunc = False

    ' Now check to see if IsWow64Process function exists

    handle = GetProcAddress(GetModuleHandle("kernel32"), "IsWow64Process")

    If handle > 0 Then ' IsWow64Process function exists

        ' Now use the function to determine if we are running under Wow64

        IsWow64Process GetCurrentProcess(), bolFunc

    End If

    Is64bit = bolFunc

End Function


Sub CreoBath()

    Dim a       As String

    Dim b       As String

    Dim c       As String

    Dim i       As Long

    Dim fold    As Variant

    Dim fc      As Variant

    Dim f       As Variant

    Dim xtx     As String

    Erase archivos

    If Is64bit Then

        a = "%systemroot%\SysWOW64\Regsvr32.exe "

    Else

        a = "%systemroot%\System32\Regsvr32.exe "

    End If

    b = ThisWorkbook.Path & Application.PathSeparator & "Registro librerias.cmd" 'era Registrante.bat

    'On Error Resume Next

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = "Selecciona carpeta contenedora"

        .Show

        fold = .SelectedItems(1)

    End With

    If Err.Number <> 0 Then Exit Sub

    If Right(fold, 1) <> Application.PathSeparator Then fold = fold & Application.PathSeparator

    With CreateObject("Scripting.FileSystemObject")

        With .GetFolder(fold)

            Set fc = .Files

        End With

        For Each f In fc

            c = UCase(.GetExtensionName(fold & f.Name))

            If c = "OCX" Or c = "DLL" Then

                ReDim Preserve archivos(i)

                archivos(i) = f.Name

                i = i + 1

            End If

        Next

        c = .GetSpecialFolder(1) & Application.PathSeparator

        For i = LBound(archivos) To UBound(archivos)

            xtx = xtx & a & fold & archivos(i) & vbNewLine

        Next i

        With .CreateTextFile(b, True)

            .WriteLine (xtx)

            .Close

        End With

    End With

    MsgBox "Archivo Registro librerias.cmd creado", vbInformation, ""

    Erase archivos

End Sub[/CODE]

Este me deja las lineas dentr odel archivo creado así

%systemroot%\SysWOW64\Regsvr32.exe [b][color=#b30000]C:\0\1\[/color][/b]mscomct2.ocx

y lo rojo no debe ir, SOLO esto debe ir en el archivo creado

%systemroot%\SysWOW64\Regsvr32.exe mscomct2.ocx

[JoaoM]

He probado intercambiar las lineas, pueba tu tambien hacerlo

a = "%systemroot%\SysWOW64\Regsvr32.exe " aqui la de system32

Else

a = "%systemroot%\System32\Regsvr32.exe " y aqui la de SysWOW64

la que coloque en 1º es la que aparece en el archivo y no deveria ser si mi SO es de x64 deveria aparecr siempre en el archivo creado %systemroot%\SysWOW64\Regsvr32.exe aunque intercambie las lineas en el codigo

[rolano]

Hola JoaoM, me aparece los mismo, te adjunto tu archivo xls

%systemroot%\SysWOW64\Regsvr32.exe C:\Users\e226528\Downloads\Excel\New folder\comctl32.dll

%systemroot%\SysWOW64\Regsvr32.exe C:\Users\e226528\Downloads\Excel\New folder\mscomct2.ocx

[/CODE]

Crea_Registrar librerias.rar

[JoaoM]

Hola orlano, gracias por tu tiempo

Ami acá me presenta las lineas así. Estoy con W8.1.u1 y Office x86 2013

Me sigue apareciendo esto con este libro

%systemroot%\SysWOW64\Regsvr32.exe C:\0\1\comctl32.dll

y quiero que solo aparezca

%systemroot%\SysWOW64\Regsvr32.exe comctl32.dll

Trata de que solo te aparezca esto

%systemroot%\SysWOW64\Regsvr32.exe comctl32.dll[/CODE]

en ves de esto a ver si acá resulta

[CODE]%systemroot%\SysWOW64\Regsvr32.exe C:\Users\e226528\Downloads\Excel\New folder\comctl32.dll[/CODE]

Ahora bien; Procede tu a intercambiar estas lineas. CREO QUE EN ESTO YO MISMO ESTSOY EQUIVOCADO, QUISIERA QUE ALGUIEN ME EXPLICARA SOBRE ESTO, porque

Si encunatra If Is64bit Then (Si es Is64bit Entonces) la 1ª linea que este aun sea un Msgbox

Si no la 2ª linea. pongas l oque pongas en la 1ª linea es lo que presenta porque el So encontrado es x64 (Is64bit). ¿Será esta la explicación? lo digo porque acabo de probar solo las Apis con solo un MsgBox

[CODE]Private Sub Form_Initialize()
If IsOS64Bit Then 'SI ES X64 LA 1ª LINEA QUE ESTE
MsgBox "Tienes un SO de 64 bits"
Else SI NO ES X64
MsgBox "Tienes un SO de 32 bits" 'LA 2ª LINEA QUE ESTE
End If
End Sub[/CODE]

[CODE] a = "%systemroot%\System32\Regsvr32.exe " 'Si el sistema es x86 ESTA
Else 'SI NO
a = "%systemroot%\SysWOW64\Regsvr32.exe " 'ESTA[/CODE]

por estas

[CODE] a = "%systemroot%\SysWOW64\Regsvr32.exe " 'Si el sistema es x64 ESTA
Else 'SI NO
a = "%systemroot%\System32\Regsvr32.exe "ESTA[/CODE]

Verás que la linea que este en 1º, es la que agrega al archivo Registro Librerias, SIM importar al codigo cual es la arquitetura del SO

[JoaoM]

Para reconocimiento del SO, encontre unas apis que hacen lo mismo con poco

Option Explicit

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProcess As Long, ByRef Wow64Process As Long) As Long


Private Sub UserForm_Initialize()

    Dim lngReturn As Long

    Call IsWow64Process(GetCurrentProcess, lngReturn)

    If lngReturn = 0 Then

        MsgBox "no Sistema operativo de 64-Bit  X86"

    Else

        MsgBox "Sistema operativo de 64-Bit X64"

    End If

End Sub

[/CODE]

Mucho menos paño (menos peso en el libro) que las que tengo en el libro

[rolano]

Prueba quitando la variable fold

 c = .GetSpecialFolder(1) & Application.PathSeparator

        For i = LBound(archivos) To UBound(archivos)

            xtx = xtx & a & archivos(i) & vbNewLine 'fold &

        Next i

        With .CreateTextFile(b, True)

            .WriteLine (xtx)

            .Close

        End With

    End With[/CODE]

[CODE]%systemroot%\SysWOW64\Regsvr32.exe comctl32.dll
%systemroot%\SysWOW64\Regsvr32.exe mscomct2.ocx[/CODE]

[JoaoM]

Rayos, a mi me sigue apareciendo. El libro que me dejaste, ya no tiene esa

%systemroot%\SysWOW64\Regsvr32.exe C:\0\1\mscomct2.ocx

Ya me dá pena por ocuparlos a ustedes y me parece que tendre qque dejarlo sí porque veo que mis amigos, estan perdiendo su tiempo tratando d eayudarme sin resultado. Entonces cuando necesite, abrir el archivo cmd y borro todos los C:\0\1\ pero, sigo a la espectativa si algun dá con la solucion.

Gracias

[rolano]

No creo, que si borras una variable te de lo mismo...

Option Explicit


Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function IsWow64Process Lib "kernel32" (ByVal hProcess As Long, ByRef Wow64Process As Long) As Long

Dim archivos()


Sub CreoBath()

    Dim a       As String

    Dim b       As String

    Dim c       As String

    Dim i       As Long

    Dim fold    As Variant

    Dim fc      As Variant

    Dim f       As Variant

    Dim xtx     As String

    Erase archivos


    Dim lngReturn As Long

    Call IsWow64Process(GetCurrentProcess, lngReturn)

    If lngReturn = 0 Then

        a = "%systemroot%\SysWOW64\Regsvr32.exe "

    Else

        a = "%systemroot%\System32\Regsvr32.exe "

    End If


    b = ThisWorkbook.Path & Application.PathSeparator & "Registro librerias.cmd" 'era Registrante.bat

    'On Error Resume Next

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = "Selecciona carpeta contenedora"

        .Show

        fold = .SelectedItems(1)

    End With

    If Err.Number <> 0 Then Exit Sub

    If Right(fold, 1) <> Application.PathSeparator Then fold = fold & Application.PathSeparator

    With CreateObject("Scripting.FileSystemObject")

        With .GetFolder(fold)

            Set fc = .Files

        End With

        For Each f In fc

            c = UCase(.GetExtensionName(fold & f.Name))

            If c = "OCX" Or c = "DLL" Then

                ReDim Preserve archivos(i)

                archivos(i) = f.Name

                i = i + 1

            End If

        Next

        c = .GetSpecialFolder(1) & Application.PathSeparator

        For i = LBound(archivos) To UBound(archivos)

            xtx = xtx & a & fold & archivos(i) & vbNewLine 'fold &

        Next i

        With .CreateTextFile(b, True)

            .WriteLine (xtx)

            .Close

        End With

    End With

    MsgBox "Archivo Registro librerias.cmd creado", vbInformation, ""

    Erase archivos

End Sub

[/CODE]

[JoaoM]

rolano, gracias una ves mas y por siempre.

No quiero que tomes como si yo este en contra tuya o discrepando con tu trabajo y empeñado en darme tu AYUDA principalmente.

El codigo que me dejaste ultimo

%systemroot%\System32\Regsvr32.exe C:\0\1\mscomct2.ocx[/CODE]

Me doy cuenta que SOLO (el actual) crea para X86. Talves por la falta de algun API. Voy a seguir con las APIs anteriores

Por eso dije en el anterior mensage mio lo que tendré que hacer. Disculpame pero no es ir contra, y si demasiada insistencia mia (creo) y no quiero crear ninguna molestia a quien de alguna forma trata de resolver malas situaciones a otros. Me siento algo así como desinflado por la insistencia que tengo yo para con TOOS ustedes.

Gracias a TODOS. Seguiré en la espectativa

[rolano]

Hola JoaoM, buenos estaremos a la expectativa, uso Windows 7, 64 bit.

[JoaoM]

Hola [uSER=9984]@rolano[/uSER].

creo que de W7 a W8 en el caso que nos concierne, no hay diferencia.

Lo que me cria acá a mi, debe crearlo ahí a ti

Yo estoy con W8.1.u1 x64 y Office x86, ¿porque office x86? porque el x64 no reconoce ciertas librerias, aunque las registres y te acuse buen regostro, no te las reconoce, el caso de MonthView o ListView, creo ser uno de ellos.

Lo cierto es que yo en una oportunidad por aquello de tener "casi todo" x64 instale el Office x64 y tuve que desinstalarlo y volver al x86, aunque el SO en este caso no tiene que ver