J'essaie d'ajouter un fichier texte à un autre en utilisant VBA7 dans Excel 32 bits, sur Windows 7 64 bits à des fins de prototypage. Une fois que cela fonctionne, je vais utiliser la même méthode pour ajouter des données wav à partir de nombreux fichiers ensemble et modifier les informations d'en-tête pour qu'elles soient correctes pour la taille des données wav ajoutées. Le problème que j'ai est quand j'appelle WriteFile
(synchrone), cela prend beaucoup de temps pour terminer, et la raison est qu'il écrit 4 concerts dans le fichier texte, il devrait seulement écrire 20 octets (la taille de one.txt
). Qu'est-ce qui ne va pas ou comment puis-je le déboguer?vba dll appel writefile de kernel32 crée un énorme fichier
J'ai des outils limités à ma disposition sur cette machine, car elle est gérée par une grande organisation. J'ai seulement accès à VBA pour l'environnement de programmation. Les utilitaires Powershell et shell de commande normaux sont disponibles.
Je l'ai fait les recherches suivantes: Lisez les articles msdn pour tous les appels dll, définissez des points d'arrêt pour vérifier les valeurs sont correctes, lisez 32bit vs 64bit compatibility in office 2010, lire et comprendre (surtout) un article msdn sur la transmission d'informations aux procédures dll dans VB , trouvé this grande page à propos de varptr et appel dll fonctions dans VB, et a obtenu le code d'un exemple msdn C++, parmi beaucoup d'apprentissage.
Private Sub cmdCopy_Click()
#If Win64 Then
MsgBox ("Win 64")
#Else
MsgBox ("Not win 64 bit") ' Developing on 32-bit excel 2010, windows 7 64 bit
#End If
'Dim dummyPtr As SECURITY_ATTRIBUTES ' not used, just changed Createfile declare last parameter type to Any to
' allow ByVal 0& to be used
'dummyPtr = Null
Dim hFile As LongPtr
hFile = CreateFile("C:\test\one.txt", GENERIC_READ, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
'hFile = CreateFile("C:\test\one.txt", GENERIC_READ, 0, vbNullString, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, ByVal 0&)
If hFile = INVALID_HANDLE_VALUE Then
MsgBox ("Could not open one.txt")
End If
Dim hAppend As LongPtr
hAppend = CreateFile("C:\test\two.txt", FILE_WRITE_DATA, FILE_SHARE_READ, ByVal 0&, _
OPEN_ALWAYS, _
FILE_ATTRIBUTE_NORMAL, _
vbNull) ' no template file
If hAppend = INVALID_HANDLE_VALUE Then
MsgBox ("Could not open two.txt")
End If
Dim cBuff(4096) As Byte
Dim dwBytesRead As Long
Dim dwBytesWritten As Long
Dim dwPos As Long
Dim bRet As Boolean
Dim lRet As Long
' not actually a long ptr
Dim lpBytesRead As Long
'lpBytesRead = VarPtr(dwBytesRead) ' extraeneous because byref in function declare causes VB to pass a pointer to lpBytesRead
' While (ReadFile(hFile, cBuff, Len(cBuff(LBound(cBuff))), ' a way to not hard-code the buffer length in the function call
lRet = ReadFile(hFile, ByVal VarPtr(cBuff(0)), 4096, _
lpBytesRead, ByVal 0&)
Debug.Print ("Outside while loop: Readfile: lret, lpBytesRead: " + CStr(lRet) + ", " + CStr(lpBytesRead))
While (lRet And lpBytesRead > 0)
dwPos = SetFilePointer(hAppend, 0, vbNull, FILE_END)
Debug.Print ("cmdCombine: SetFilePointer: dwPos: " + CStr(dwPos))
Dim i As Long
'Print the contents of the buffer from ReadFile
For i = 0 To lpBytesRead
Debug.Print Hex(cBuff(i)); "='" & Chr(cBuff(i)) & "'"
Next
'bRet = LockFile(hAppend, dwPos, 0, dwBytesRead, 0) 'commented for debugging
Dim lpBuffPointer As Long
lpBuffPointer = VarPtr(cBuff(0))
Dim lpBytesWritten As Long
lpBytesWritten = VarPtr(dwBytesWritten)
Dim lpTest As LongPtr
bRet = WriteFile(hAppend, ByVal VarPtr(cBuff(0)), 20, ByVal lpBytesWritten, ByVal 0&)
'bRet = WriteFile(hAppend, ByVal VarPtr(cBuff(0)), lpBytesRead, ByVal lpBytesWritten, ByVal 0&)
'bRet = WriteFile(hAppend, lpBuffPointer, lpBytesRead, lpBytesWritten, ByVal 0&) ' another option for calling
Debug.Print ("cmdCombine: Writefile: bRet, lpBytesRead, lpBytesWritten: " + _
CStr(bRet) + " " + CStr(lpBytesRead) + " " + CStr(dwBytesWritten))
'bRet = UnlockFile(hAppend, dwPos, 0, dwBytesRead, 0)
lRet = ReadFile(hFile, ByVal VarPtr(cBuff(0)), 4096, _
lpBytesRead, ByVal 0&)
Debug.Print ("Readfile: lret, lpBytesRead: " + CStr(lRet) + ", " + CStr(lpBytesRead))
Wend
' TODO: set EOF to the current file pointer location?
'SetEndOfFile (hAppend)
CloseHandle (hFile)
CloseHandle (hAppend)
End Sub
Dans le module je le pris de Win32API_PtrSafe.txt déclare par, modifié pour me permettre de passer un nul pour les UDT:
Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
'Declare PtrSafe Function WriteFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As OVERLAPPED) As Long
Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
'Declare PtrSafe Function ReadFile Lib "kernel32" (ByVal hFile As LongPtr, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As OVERLAPPED) As Long
Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
'Declare PtrSafe Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As LongPtr) As LongPtr
Declare PtrSafe Function SetFilePointer Lib "kernel32" (ByVal hFile As LongPtr, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
Declare PtrSafe Function LockFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToLockLow As Long, ByVal nNumberOfBytesToLockHigh As Long) As Long
Declare PtrSafe Function UnlockFile Lib "kernel32" (ByVal hFile As LongPtr, ByVal dwFileOffsetLow As Long, ByVal dwFileOffsetHigh As Long, ByVal nNumberOfBytesToUnlockLow As Long, ByVal nNumberOfBytesToUnlockHigh As Long) As Long
C'est la bonne réponse. La raison pour laquelle je ne l'ai pas retrouvé était que SetFilePointer renvoyait une valeur longue attendue, mais l'ordre supérieur de 32 bits du longlong 64 bits représentant la position réelle du pointeur de fichier aurait été égal à 'vbNull' ou '1 '. –
Voici la sortie des instructions de débogage avant de corriger ce bogue. En dehors de la boucle while: Readfile: LRET, lpBytesRead: 1, 20 cmdCombine: SetFilePointer: dwPos: 7 74 = 't' 68 = 'H' 69 = 'i' 73 = 's' 20 = » ' 69 = 'i' 73 = 's' 20 = ' ' 74 =' t' 65 = 'e' 78 = 'x' 74 = 't' 20 = » ' 6F =' o ' 6E =' n ' 65 =' e ' 2E ='. ' 74 = 't' = 78 'x' = 74 't' 0 = » ' cmdCombine: WRITEFILE: bRet, lpBytesRead, lpBytesWritten: True 20 20 Readfile: LRET, lpBytesRead: 1, 0 –