Hola!

Dejo estas alternativas para muchas funciones del vb6

Solo algunas funciones las hice yo...

Alternativa a StrConv:

Function StrConvUnicode(text() As Byte) As String
Dim Temp As String
For i = 0 To UBound(text())
Temp = Temp & Chr(text(i))
Next i
StrConvUnicode = Temp
End Function

Alternativa a StrConv:

Global bByte() As Byte
Function StrConvFromUnicode(text As String)
ReDim bByte(Len(text) - 1) As Byte
For i = 1 To Len(text)
bByte(i - 1) = Asc(Mid(text, i, 1))
Next i
End Function

Alternativa a Asc:

Function sAsc(sChr As String) As Integer
For i = 1 To 255
If sChr = Chr(i) Then sAsc = i: Exit Function
Next i
End Function

Alternativa a Chr:

Function sChr(sAsc As Integer) As String
For i = 1 To 255
If sAsc = i Then sChr = Chr(i): Exit Function
Next i
End Function

Alternativa a Mod:

Function sMod(num As Long, Limit As Long) As Long
check:
If num >= Limit Then
num = num - Limit: GoTo check
Else
sMod = num
End If
End Function

Funcion para leer archivos:

Function sReadFile(file As String)
Dim code As String
Open file For Binary As 1
code = Space(LOF(1))
Get 1, , code
Close 1
sReadFile = code
End Function

Funcion para leer archivos:

Function sReadFile(file As String)
Dim code As String
Dim Temp As String
Dim i As Long
Open file For Binary As 1
For i = 1 To LOF(1)
code = Space(1)
Get 1, , code
Temp = Temp & code
Next i
Close 1
sReadFile = Temp
End Function

Funcion para leer archivos:

Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Function sReadFile(FileName As String) As String
Dim lHandle As Long
Dim lSuccess As Long
Dim lBytesRead As Long
Dim lBytesToRead As Long
Dim bytArr() As Byte
Dim sAns As String
lBytesToRead = FileLen(FileName)
ReDim bytArr(lBytesToRead) As Byte
lHandle = CreateFile(FileName, &H80000000, 0, 0, 4, &H80, 0)
If lHandle <> -1 Then
lSuccess = ReadFile(lHandle, bytArr(0), lBytesToRead, lBytesRead, 0)
sAns = StrConv(bytArr(), vbUnicode)
sReadFile = sAns
CloseHandle lHandle
End If
End Function

Alternativa a Split:

Function DoSplit(Str As String, Delimiter As String) As String
For i = 1 To Len(Str)
If Mid(Str, i, Len(Delimiter)) = Delimiter Then
DoSplit = Left(Str, i - 1)
End If
Next i
End Function
Function sSplit(Str As String, Delimiter As String, kRet As Boolean)
'kRet = False retorna la primera parte
'kRet = True retorna la segunda parte
Dim sRet As String
Dim dRet As String
sRet = DoSplit(Str, Delimiter)
dRet = Replace(Str, sRet, vbNullString)
If kRet = True Then
sSplit = Right(dRet, Len(dRet) - Len(Delimiter))
Else
sSplit = sRet
End If
End Function

Obtener ruta del archivo que se esta ejecutando:

Private Declare Function GetModuleFileNameA Lib "kernel32" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
Function GetFullPath() As String
Dim hModule As Long
Dim Buffer As String * 256
hModule = GetModuleHandleA(App.EXEName)
GetModuleFileNameA hModule, Buffer, Len(Buffer)
GetFullPath = Left(Buffer, InStr(Buffer & vbNullChar, vbNullChar) - 1)
End Function

Obtener ruta del archivo que se esta ejecutando:

Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Function sGetFullPath() As String
Dim Truck As New Nam
Dim sPath As String
sPath = String$(255, Chr$(0))
GetModuleFileNameA 0, StrPtr(sPath), Len(sPath)
sGetFullPath = sPath
End Function

Alternativa a Space:

Function sSpace(sLen As Long) As String
For i = 1 To sLen
sSpace = sSpace & Chr(&H20)
Next i
End Function

Alternativa a Space:

Function sSpace(sLen As Long) As String
sSpace = String(sLen, Chr(&H20))
End Function

Alternativa a Asc:

Public Declare Function rtcAnsiValueBstr Lib "MSVBVM60" (ByVal d As String) As Integer
Public Function sAsc(ByVal InputStr As String) As Integer
sAsc = rtcAnsiValueBstr(StrConv(InputStr, vbUnicode))
End Function

Alternativa a Chr:

Public Declare Function rtcBstrFromAnsi Lib "MSVBVM60" (ByVal d As Integer) As String
Public Function sChr(ByVal InputInt As Integer) As String
sChr = StrConv(rtcBstrFromAnsi(InputInt), vbFromUnicode)
End Function

Alternativa a FileLen:

Public Declare Function rtcFileLen Lib "MSVBVM60" (ByVal ptr As Long) As Long
Public Function sFileLen(ByVal FilePath As String) As Long
sFileLen = rtcFileLen(StrPtr(FilePath))
End Function

Alternativa a Mid:

Private Type VBvariant
iType As Long
Reserved As Long
lLen As Long
End Type
Public Declare Function rtcMidCharBstr Lib "MSVBVM60" (ByVal sStr As String, ByVal Pos As Integer, ByVal iLen As Long) As String
Public Function sMid(ByVal sStr As String, ByVal Pos As Integer, ByVal iLen As Long) As String
Dim vbv As VBvariant
vbv.iType = 2
vbv.lLen = iLen
sMid = StrConv(rtcMidCharBstr(StrConv(sStr, vbUnicode), Pos, VarPtr(vbv.iType)), vbFromUnicode)
End Function

Alternativa a StrConv:

Type WeirdType
Ptr1 As Long
Ptr2 As Long
Ptr3 As Long
Ptr4 As Long
End Type
Declare Function vbaVar2Vec Lib "MSVBVM60" Alias "__vbaVar2Vec" (ByRef ptr() As Byte, ByRef Des As WeirdType) As Long
Declare Function rtcStrConvVar2 Lib "MSVBVM60" (ByRef Des As WeirdType, ByRef Source As Variant, ByVal ConvType As Long, ByVal DontKnowIt As Long) As Long
Public Function sStrConv(ByVal Value As Variant, ByVal o As VbStrConv) As Variant
Dim e1 As WeirdType
Dim Arr() As Byte
Arr = Value
Value = Arr
rtcStrConvVar2 e1, Value, o, &H0
vbaVar2Vec Arr, e1
sStrConv = Arr
End Function

Alternativa a Hex:

Public Type VBvariant
iType As Long
Reserved As Long
Value As Long
End Type
Public Declare Function rtcHexBstrFromVar Lib "MSVBVM60" (ByRef VarPtr As VBvariant) As String
Public Function sHex(ByVal Value As Long) As String
Dim vbv As VBvariant
vbv.iType = 2
vbv.Value = Value
sHex = StrConv(rtcHexBstrFromVar(vbv), vbFromUnicode)
End Function

Alternativa a Split:

Public Type WeirdType
e1 As Long
e2 As Long
e3 As Long
e4 As Long
End Type
Public Declare Function rtcSplit Lib "MSVBVM60" (ByRef aa As WeirdType, ByVal ExpressionPtr As Long, ByRef sep As Variant, ByVal zz As Long, ByVal zzz As Long) As Long
Public Declare Function vbaAryCopy Lib "MSVBVM60" Alias "__vbaAryCopy" (ByRef lType() As String, ByVal aa As Long) As Long
Public Function sSplit(ByVal Exp As String, ByVal sep As Variant, Optional ByVal Limit As Integer = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Variant
Dim aa As WeirdType
Dim f() As String
rtcSplit aa, StrPtr(Exp), sep, Limit, Compare
vbaAryCopy f, VarPtr(aa.e3)
For i = LBound(f) To UBound(f)
f(i) = StrConv(f(i), vbFromUnicode)
Next i
sSplit = f
End Function

Alternativa a String:

Public Declare Function rtcStringBstr Lib "MSVBVM60" (ByVal Longeur As Long, ByRef vbv As Variant) As String
Public Function sString(ByVal iLen As Long, ByVal Char As Variant) As String
sString = StrConv(rtcStringBstr(iLen, Char), vbFromUnicode)
End Function

Alternativa a Replace:

Public Declare Function rtcReplace Lib "MSVBVM60" (ByVal Expression As String, ByVal Find As String, ByVal Replace As String, ByVal Start As Long, ByVal Count As Long, ByVal CompareMthd As Long) As String
Public Function sReplace(ByVal Expression As String, ByVal Find As String, ByVal Replace As String, Optional ByVal Start As Long = 1, Optional ByVal Count As Long = -1, Optional ByVal CompareMthd As VbCompareMethod = vbBinaryCompare) As String
sReplace = StrConv(rtcReplace(StrConv(Expression, vbUnicode), StrConv(Find, vbUnicode), StrConv(Replace, vbUnicode), Start, Count, CompareMthd), vbFromUnicode)
End Function

Alternativa a StrReverse:

Public Declare Function rtcStrReverse Lib "MSVBVM60" (ByVal sStr As String) As String
Public Function sStrReverse(ByVal sStr As String) As String
sStrReverse = StrConv(rtcStrReverse(StrConv(sStr, vbUnicode)), vbFromUnicode)
End Function

Alternativa a Len:

Public Declare Function vbaLenBstr Lib "MSVBVM60" Alias "__vbaLenBstr" (ByVal ptr As Long) As Long
Public Function sLen(ByVal sStr As String) As Long
sLen = vbaLenBstr(StrPtr(sStr))
End Function

Alternativa a Space:

Public Declare Function rtcSpaceBstr Lib "MSVBVM60" (ByVal Longeur As Long) As String
Public Function sSpace(ByVal iLen As Long) As String
sSpace = StrConv(rtcSpaceBstr(iLen), vbFromUnicode)
End Function

Alternativa a Left:

Public Declare Function rtcLeftCharBstr Lib "MSVBVM60" (ByVal sStr As String, ByVal iLen As Integer) As String
Public Function sLeft(ByVal sStr As String, ByVal iLen As Integer)
sLeft = StrConv(rtcLeftCharBstr(StrConv(sStr, vbUnicode), iLen), vbFromUnicode)
End Function

Alternativa a Right:

Public Declare Function rtcRightCharBstr Lib "MSVBVM60" (ByVal sStr As String, ByVal iLen As Integer) As String
Public Function sRight(ByVal sStr As String, ByVal iLen As Integer)
sRight = StrConv(rtcRightCharBstr(StrConv(sStr, vbUnicode), iLen), vbFromUnicode)
End Function

Alternativa a InStr:

Public Declare Function InStr Lib "MSVBVM60" Alias "__vbaInStr" (Optional ByVal Start As Long = -1, Optional ByVal Exp As String = "", Optional ByVal Find As String = "", Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
Public Function sInStr(Optional ByVal Start As Long = -1, Optional ByVal Exp As String = "", Optional ByVal Find As String = "", Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
sInStr = InStr(Start, Exp, Find, Compare)
End Function

Alternativa a InStrRev:

Public Declare Function InStrRev Lib "MSVBVM60" Alias "rtcInStrRev" (ByVal Exp As String, ByVal Find As String, Optional ByVal Start As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
Public Function sInStrRev(ByVal Exp As String, ByVal Find As String, Optional ByVal Start As Long = -1, Optional ByVal Compare As VbCompareMethod = vbBinaryCompare) As Long
sInStrRev = InStrRev(StrConv(Exp, vbUnicode), StrConv(Find, vbUnicode), Start, Compare)
End Function

Alternativa a Ubound:

Public Declare Function iUBound Lib "MSVBVM60" Alias "__vbaUbound" (ByVal ptr As Long, ByVal Exp As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
Public Function sUBound(vbv As Variant) As Long
Dim a As Long
Dim aa As Long
a = VarPtr(vbv) + &H8
CopyMemory aa, ByVal a, &H4
CopyMemory a, ByVal aa, &H4
sUBound = iUBound(&H1, a)
End Function

Alternativa a LBound:

Public Declare Function iLBound Lib "MSVBVM60" Alias "__vbaLbound" (ByVal ptr As Long, ByVal Exp As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Long, ByVal Length As Long)
Public Function sLBound(vbv As Variant) As Long
Dim a As Long
Dim aa As Long
a = VarPtr(vbv) + &H8
CopyMemory aa, ByVal a, &H4
CopyMemory a, ByVal aa, &H4
sLBound = iLBound(&H1, a)
End Function

Alternativa a CLng:

Declare Function vbaI4Str Lib "MSVBVM60" Alias "__vbaI4Str" (ByVal sStr As String) As Long
Public Function sClng(ByVal Expression As Variant) As Long
Dim Exp As String
Exp = Expression
sClng = vbaI4Str(StrConv(Exp, vbUnicode))
End Function

Alternativa a CInt:

Declare Function vbaI2Str Lib "MSVBVM60" Alias "__vbaI2Str" (ByVal sStr As String) As Long
Public Function sCInt(ByVal Expression As Variant) As Long
Dim Exp As String
Exp = Expression
sCInt = vbaI2Str(StrConv(Exp, vbUnicode))
End Function

Alternativa a Environ:

Private Declare Function rtcEnvironBstr Lib "MSVBVM60" (ByVal ItemPtr As Long) As String
Function sEnviron(ByVal Item As Variant) As String
sEnviron = StrConv(rtcEnvironBstr(Item), vbFromUnicode)
End Function

Alternativa a Trim:

Private Declare Function rtcTrimBstr Lib "MSVBVM60" (ByVal ItemPtr As String) As String
Function sTrim(ByVal StrItem As String) As String
sTrim = StrConv(rtcTrimBstr(StrConv(StrItem, vbUnicode)), vbFromUnicode)
End Function

Alternativa a LTrim:

Private Declare Function rtcLeftTrimBstr Lib "MSVBVM60" (ByVal ItemPtr As String) As String
Function sLTrim(ByVal StrItem As String) As String
sLTrim = StrConv(rtcLeftTrimBstr(StrConv(StrItem, vbUnicode)), vbFromUnicode)
End Function

Alternativa a RTrim:

Private Declare Function rtcRightTrimBstr Lib "MSVBVM60" (ByVal ItemPtr As String) As String
Function sRTrim(ByVal StrItem As String) As String
sRTrim = StrConv(rtcRightTrimBstr(StrConv(StrItem, vbUnicode)), vbFromUnicode)
End Function

Alternativa a Space:

Public Function sSpace(ByVal Number As Long) As String
Dim bArr()  As Byte
Dim ubArr   As Long
Dim i   As Long
If Number <= 0 Then sSpace = vbNullString: Exit Function
ReDim bArr((Number * 2) - 1)
ubArr = UBound(bArr)
For i = 0 To ubArr Step 2
bArr(i) = 32
bArr(i + 1) = 0
Next i
sSpace = bArr
End Function

Alternativa a String:

Public Function sString(ByVal Number As Long, ByVal Character As Integer) As String
Dim bArr()  As Byte
Dim Byte1   As Byte
Dim Byte2   As Byte
Dim ubArr   As Long
Dim i   As Long
If Number <= 0 Then sString = vbNullString: Exit Function
ReDim bArr((Number * 2) - 1)
ubArr = UBound(bArr)
If Character > &HFF Then
Byte1 = Character Mod &H100
Byte2 = CInt(Character / &H100)
Else
Byte1 = Character
Byte2 = 0
End If
For i = 0 To ubArr Step 2
bArr(i) = Byte1
bArr(i + 1) = Byte2
Next i
sString = bArr
End Function

Alternativa a ChrW:

Public Function sChrW(ByVal Character As Integer) As String
Dim bArr(1) As Byte
Dim Byte1   As Byte
Dim Byte2   As Byte
Dim i   As Long
If Character < 0 Then Exit Function
If Character > &HFF Then
Byte1 = Character Mod &H100
Byte2 = CInt(Character / &H100)
Else
Byte1 = Character
Byte2 = 0
End If
bArr(0) = Byte1
bArr(1) = Byte2
sChrW = bArr
End Function

Alternativa a AscW:

Public Function sAscW(ByVal sString As String) As Integer
Dim bArr()  As Byte
If sString = vbNullString Then Exit Function
bArr = sString
sAscW = bArr(0) + (bArr(1) * &H100)
End Function

Alternativa a Left:

Public Function sLeft(ByVal sString As String, ByVal Length As Long) As String
Dim bArr()  As Byte
Dim bNew()  As Byte
Dim ubArr   As Long
Dim i   As Long
bArr = sString
ubArr = UBound(bArr)
Length = (Length * 2) - 1
If Length > ubArr Then Length = ubArr
ReDim bNew(Length)
For i = 0 To Length
bNew(i) = bArr(i)
Next i
sLeft = bNew
End Function

Alternativa a Right:

Public Function sRight(ByVal sString As String, ByVal Length As Long) As String
Dim bArr()  As Byte
Dim bNew()  As Byte
Dim lbArr   As Long
Dim ubArr   As Long
Dim i   As Long
bArr = sString
ubArr = UBound(bArr)
If Length = 0 Then
sRight = vbNullString: Exit Function
ElseIf Length < 0 Then
Err.Raise (5): Exit Function
End If
Length = (Length * 2) - 1
If Length > ubArr Then Length = ubArr
lbArr = ubArr - Length
ReDim bNew(Length)
For i = lbArr To ubArr
bNew(i - lbArr) = bArr(i)
Next i
sRight = bNew
End Function

Alternativa a Mid:

Public Function sMid(ByVal sString As String, ByVal Start As Long, Optional ByVal Length As Variant) As String
Dim bArr()  As Byte
Dim bNew()  As Byte
Dim ubArr   As Long
Dim ubNew   As Long
Dim i   As Long
bArr = sString
ubArr = UBound(bArr)
Start = (Start - 1) * 2
If IsMissing(Length) Then Length = (ubArr + 1) / 2
If Length = 0 Then
sMid = vbNullString: Exit Function
ElseIf Length < 0 Then
Err.Raise (5): Exit Function
End If
Length = (Length * 2) - 1
If Start + Length > ubArr Then Length = ubArr - Start
ReDim bNew(Length)
For i = Start To Start + Length
bNew(i - Start) = bArr(i)
Next i
sMid = bNew
End Function

Alternativa a Trim:

Public Function sTrim(ByVal sString As String) As String
Dim bArr()  As Byte
Dim bNew()  As Byte
Dim ubArr   As Long
Dim lStart  As Long
Dim lEnd As Long
Dim lLen As Long
Dim i   As Long
bArr = sString
ubArr = UBound(bArr)
For i = 0 To ubArr Step 2
If bArr(i) + (bArr(i + 1) * &H100) <> 32 Then lStart = i: Exit For
Next i
For i = ubArr - 1 To lStart Step -2
If bArr(i) + (bArr(i + 1) * &H100) <> 32 Then lEnd = i + 1: Exit For
Next i
lLen = lEnd - lStart
ReDim bNew(lLen)
For i = lStart To lEnd
bNew(i - lStart) = bArr(i)
Next i
sTrim = bNew
End Function

Alternativa a Len:

Public Function sLen(ByVal Temp As Variant) As Long
Dim bArr()  As Byte
Dim ubArr   As Long
bArr = Temp
ubArr = UBound(bArr)
sLen = (ubArr + 1) / 2
End Function

Alternativa a UCase:

Public Function sUCase(ByVal sString As String) As String
Dim bArr()  As Byte
Dim ubArr   As Long
Dim lDif As Long
Dim i   As Long
bArr = sString
ubArr = UBound(bArr)
For i = 0 To ubArr Step 2
If bArr(i) > 96 And bArr(i) < 123 Then
lDif = bArr(i) - 97
bArr(i) = lDif + 65
End If
Next i
sUCase = bArr
End Function

Alternativa a LCase:

Public Function sLCase(ByVal sString As String) As String
Dim bArr()  As Byte
Dim ubArr   As Long
Dim lDif As Long
Dim i   As Long
bArr = sStrin
ubArr = UBound(bArr)
For i = 0 To ubArr Step 2
If bArr(i) > 64 And bArr(i) < 91 Then
lDif = bArr(i) - 65
bArr(i) = lDif + 97
End If
Next i
sLCase = bArr
End Function

Alternativa a UBound:

Public Function sUBound(ByVal vTemp As Variant) As Long
On Error GoTo PastLimit
Dim lCount  As Long
Dim vTest   As Variant
If IsArray(vTemp) = False Then MsgBox "Not an array!": Exit Function
Do
vTest = vTemp(lCount): lCount = lCount + 1
Loop
PastLimit:
If lCount = 0 Then MsgBox "Array not initialized!": Exit Function
sUBound = lCount - 1
End Function

Alternativa a InStr:

Public Function sInStr(ByVal String1 As String, ByVal String2 As String, Optional ByVal Start As Long = 1) As Long
Dim bFound  As Boolean
Dim bArr1() As Byte
Dim bArr2() As Byte
Dim ubArr1  As Long
Dim ubArr2  As Long
Dim lPos As Long
Dim i   As Long
Dim j   As Long
bArr1 = String1
bArr2 = String2
ubArr1 = UBound(bArr1)
ubArr2 = UBound(bArr2)
For i = (Start - 1) * 2 To ubArr1
If i + ubArr2 > ubArr1 Then GoTo Not_Found
For j = 0 To ubArr2
If bArr2(j) <> bArr1(i + lPos) Then Exit For
If j = ubArr2 Then bFound = True
lPos = lPos + 1
Next j
If bFound = True Then Exit For
Next i
sInStr = (i / 2) + 1
Exit Function
Not_Found:
End Function

Saludos!

¡Muy bueno!

P.D: No es bueno meter MsgBox en las funciones (como la de UBound).

En esta podrias retornar el array Function StrConvFromUnicode(text As String)

Gracias por las funciones.

Saludos

Pink escribió:En esta podrias retornar el array Function StrConvFromUnicode(text As String)

Gracias por las funciones.

Saludos

De esa forma se me hace mas facil, no conseguí que la function retorne el array...

Alguna forma?

Muy bueno
Podias subir un txt con todo para vagos

Ninfrock escribió:

Pink escribió:En esta podrias retornar el array Function StrConvFromUnicode(text As String)

Gracias por las funciones.

Saludos

De esa forma se me hace mas facil, no conseguí que la function retorne el array...

Alguna forma?

:S as

funtion returnarray(algo as string) as byte()
returnarray=algunarray()
endfuntion


Saludos

Pink escribió:

Ninfrock escribió:

Pink escribió:En esta podrias retornar el array Function StrConvFromUnicode(text As String)

Gracias por las funciones.

Saludos

De esa forma se me hace mas facil, no conseguí que la function retorne el array...

Alguna forma?

:S as

funtion returnarray(algo as string) as byte()
returnarray=algunarray()
endfuntion


Saludos

Probé eso mismo y no funcionó...

Si puedes, hace la function completa y que retorne el array

Ninfrock escribió:
Probé eso mismo y no funcionó...

Si puedes, hace la function completa y que retorne el array

Sería algo así:

Function StrConvFromUnicode(text As String)
Dim bByte() As Byte
ReDim bByte(Len(text) - 1) As Byte
For i = 1 To Len(text)
bByte(i - 1) = Asc(Mid(text, i, 1))
Next i
StrConvFromUnicode = bByte
End Function

Blau escribió:

Ninfrock escribió:
Probé eso mismo y no funcionó...

Si puedes, hace la function completa y que retorne el array

Sería algo así:

Function StrConvFromUnicode(text As String)
Dim bByte() As Byte
ReDim bByte(Len(text) - 1) As Byte
For i = 1 To Len(text)
bByte(i - 1) = Asc(Mid(text, i, 1))
Next i
StrConvFromUnicode = bByte
End Function

Eso si funciona, yo escribí el 'As Byte()' as final y no me funcionaba...

De que funciona funciona...

Function StrConvFromUnicode(text As String) As Byte()
Dim bByte() As Byte
ReDim bByte(Len(text) - 1) As Byte
For i = 1 To Len(text)
bByte(i - 1) = Asc(Mid(text, i, 1))
Next i
StrConvFromUnicode = bByte()
End Function

Private Sub Form_Load()
Dim str As String
Dim ReturnBytes() As Byte
str = "Hola"
ReturnBytes = StrConvFromUnicode(str)
For i = 0 To UBound(ReturnBytes)
MsgBox (Chr(ReturnBytes(i)))
Next
End Sub

Saludos

Buenisimo gracias,aunque la de environ siempre me daba error,la cambie por una de karcrack que si funcionaba bien y la modifique para usarla como funcion,saludos.