اجعل برنامجك يعمل على النواتين 32بت و 64بت

[jjafferr]

ظاهرا هناك خلل في نسخة الاوفيس المستخدمة ، فجرب ان تعمل لها تحديث ، او جرب نسخة اخرى فيها جميع تحديثات الاوفيس 🙂

 

جعفر

[عبدالله المجرب]

تم التوصل الى الخلل 

في هذه الدالة apiGetUserName

 

 

بالذات هذا السطر 

nSize As Long

لازم يكون 

nSize As LongPtr

 

طلبي الان هو التعديل في الكود بخيث يعمل على النواتين

Option Compare Database
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long

#Else
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    #End If

Function fOSUserName() As String
' Returns the network login name




Dim lngLen As Long, lngx As Long

Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngx = apiGetUserName(strUserName, lngLen)
    If (lngx > 0) Then
        fOSUserName = Left$(strUserName, lngLen - 1)
    Else
        fOSUserName = vbNullString
    End If
End Function

بالذات في هذه الدالة

 

Function fOSUserName() As String
' Returns the network login name




Dim lngLen As Long, lngx As Long

Dim strUserName As String
    strUserName = String$(254, 0)
    lngLen = 255
    lngx = apiGetUserName(strUserName, lngLen)
    If (lngx > 0) Then
        fOSUserName = Left$(strUserName, lngLen - 1)
    Else
        fOSUserName = vbNullString
    End If
End Function

 

لانها ظهرت اخطاء في هذه الاسطر 

 

 lngx = apiGetUserName(strUserName, lngLen)

   

وهذا السطر

       

 fOSUserName = Left$(strUserName, lngLen - 1)

 

 

 

[jjafferr]

جرب هذا

احذف هذه الاسطر
#If VBA7 Then
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As LongPtr) As Long

#Else
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    #End If


واستبدلها بهذا
Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

 

فيه تعديل في السطر الاخير ، فلا تستعمل السطر اللي عندك ، وانما اعمل نسخ للسطر الذي كتبته لك اعلاه 🙂

 

جعفر

[عبدالله المجرب]

هل تقصد ان الدالة بوضعها التالي 

Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

ستعمل على النواتين

 

[jjafferr]

نعم ، حسب بيانات مايكروسوفت في الملف Win32API_PtrSafe والمرفق في اول مشاركة لي 🙂

 

جعفر

[عبدالله المجرب]

ان شاء الله اجرب واعلمك النتيجة

[عبدالله المجرب]

في ٤‏/٥‏/٢٠٢٢ at 20:52, عبدالله المجرب said:

هل تقصد ان الدالة بوضعها التالي 

Private Declare PtrSafe Function apiGetUserName Lib "advapi32.dll" Alias _
    "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

ستعمل على النواتين

 

جربت هذا الحل والى الان الامور تمام 

سلمت استاذ جعفر 

شكرا لك وكل عام والجميع بخير

[jjafferr]

26 دقائق مضت, عبدالله المجرب said:

جربت هذا الحل والى الان الامور تمام 

الحمدلله 🙂