- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello,
I am not a professional developer, but a researcher trying to run a numerical model and now it looks like I am a hole. Before keep digging I send this post in case someone else has had a similar problem and could be kind to send me some light
I am running a simulation model which I have programmed and compiled as a DLL in Fortran in VSE to be called from an excel file VBA macro. The excel file works and an interface for inputs and outputs from the model.
It has worked well ifor years in several Windows 7 platforms. The one I have now re-tested at home is compiled on windows 7 professional on an Intel Core I7. It has been compiled with VSE2010. I works providing that I used this option for the libraries while compiling: .
Project > Settings > Fortran > Libraries > Use Run-Time Library > Multithreaded
Now when I try to excecute it in a different machine with Windows 10 Pro, on a Core i7 (8th generation), give me this error:
Run-time error '48':
File not found: myfilename.dll
Of course the path is correct.It is the same error that used to give when compiling the libraries with the wrong option, but now I have tried all the compiling options for the library and I keep having the same error.
I have tried to compiled it in the same new Machine using another VSE (2016) and give me the same error.
A funny final fact in case it helps. I have a very old version of the same model (compiled like 8 year ago on an old machine and older Firtran compiler, which I have no access anymore) that works in both computers.
I looks like in its current configuration in the new machine VBA can´t access the DLL butI do not hava a hint.I will appreciate any hint that could help me to move forward.
Thanks in advance
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You absolutely need STDCALL for that, but must also make sure that every procedure argument in the Fortran routine has REFERENCE. You could also use:
!DEC$ ATTRIBUTES STDCALL, REFERENCE :: WABB00
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
First hint - VBA lies when it says it can't find your DLL. This message is given any time it runs into trouble loading the DLL. The usual cause of this is that a dependent DLL can't be found. You say you have linked your DLL statically, which should eliminate that, but it would be worthwhile to download Dependency Walker, have it analyze your DLL and see if there's a dependent DLL you're not expecting. The tool may complain about a bunch of other things which I suggest you ignore for now.
Another possibility is that you are running 32-bit VBA and trying to use a 64-bit DLL, or vice-versa. Generally you want a 32-bit DLL for VBA.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks Steve. I will try to use the dependecy walker and double check that I am not mixing 32 and 64-bit versions.
ç
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello Steve,
thakns agin for youradvice. I have been working on it and compiling the DLL for 32-bit /win32/, I was already doing this wrong. Now I have a 32bits DLL.
With this I have tried to use this DLL from the Excel VBA for applications and I have make progress in a 50%. I get another error but it does something:
a) I get this message:
Runtime Error 49, Bad DLL calling convention"
I have doubled checked that there is no mismatch with number, type, and order of arguments, (although they worked properly in a previous machine)
The VBA is executed until reaches the point og gettimng back the values from the DLL into VBA.
Actually the variables from Excel into the DLL are read and the calculations performed by the DLL (I know this but the DLL writes auxiliary files and they are written onmy disk ad *.dat files and I can read them afterwards with results of internal calculations) but it seems that the problem is passing back this variables from the DLL to the Excel for writing the output results into the excel file. There it stops.
I have checked dependencies with the dependency walker (good advice I am learning quite a lot these days) and it give me these errors.
Error: At least one required implicit or forwarded dependency was not found.
Error: At least one module has an unresolved import due to a missing export function in an implicitly dependent module.
Error: Modules with different CPU types were found.
Error: A circular dependency was detected.
Warning: At least one delay-load dependency module was not found.
Warning: At least one module has an unresolved import due to a missing export function in a delay-load dependent module.
I attach a couple of screenshots of this analysis
In summary, Although I am trying to have a DLL using only 32.bits libraries I am ending to have a DLL calling x64 libraries, I am a bit lost about how to solve this.
When I use the dependecy walker to examine old DLL libraries that are working in the same machine version (but compiled in a old 32 bits machine to whom I have no access anymore) I can check that this Fortran DLL is only calling the KERNELL32.DLL and despite giving me similar errors than the DLL that does not work, it works properly with VBA. ( I also attach an screenshot of dependecy walker).
Error: At least one required implicit or forwarded dependency was not found.
Error: At least one module has an unresolved import due to a missing export function in an implicitly dependent module.
Error: Modules with different CPU types were found.
Error: A circular dependency was detected.
Warning: At least one delay-load dependency module was not found.
Warning: At least one module has an unresolved import due to a missing export function in a delay-load dependent module.
My guess is, a guess because I am a bit lost, is that if I could compile this DLL with an option that only calls to the KErnell32:dll might work, but I do not know how to
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You need to ensure that the Fortran routines you are calling have the STDCALL attribute in their declarations. Please show the Fortran source of the declaration section (including SUBROUTINE or FUNCTION) of the procedures you call from VBA.
Ignore the DependencyWalker warnings for now. Most if not all are false.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Steve,
In my current code (which neverthless I attach complete) these are my declarations. I have tried to add the STDCALL declaration but when I do it the VBA code crashes (it closes the excel file).
Thanks for youur help, and patience
!DEC$ ATTRIBUTES DLLEXPORT::WABB00
!DEC$ ATTRIBUTES Alias:'WABB00'::WABB00
!DEC$ ATTRIBUTES REFERENCE:: clima,humeini,humsal,cn,hsat,hfcap,hpmp
!DEC$ ATTRIBUTES REFERENCE:: hres,profmax,salhyd,humday,acolfrac
!DEC$ ATTRIBUTES REFERENCE:: acolmat,dkp,dfrraol,opsieg,marco
!DEC$ ATTRIBUTES REFERENCE:: cco,ccx,gdd,cdc,tbase,fsiemb,fsieg,humemer
!DEC$ ATTRIBUTES REFERENCE:: pgcover,dsingerm,flagemer,kcbx, tcovpot
!DEC$ ATTRIBUTES REFERENCE:: fage,fraicub, prfcubmax,rcub
!DEC$ ATTRIBUTES REFERENCE:: realtcover,praic,percprof,humfixed
!DEC$ ATTRIBUTES REFERENCE:: bulpar,nugot,fugot,inrieg,horieg
!DEC$ ATTRIBUTES REFERENCE:: tbvin,GDDV,opraicvine,opfmoist
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Please show your VBA declaration of this routine.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Below it is this section. I attach the complete VBA code, Module.txt, where it can be seen best (my apologies for leaving the comments in Spanish in this txt.).
Attribute VB_Name = "Module1"
Option Explicit
Declare PtrSafe Sub WABB00 Lib "C:\Tema11\WABB00.dll" (ByRef clima As Double, ByRef humeini As Double, ByRef humsal As Double, ByRef cn As Double, _
ByRef hsat As Double, ByRef hfcap As Double, ByRef hpmp As Double, ByRef hres As Double, ByRef profmax As Double, ByRef fracco As Double, ByRef fracca As Double, _
ByRef fraccu As Double, ByRef salhyd As Double, ByRef humday As Double, ByRef acolfrac As Double, ByRef acolmat As Double, ByRef dkp As Double, _
ByRef dfrraol As Double, ByRef cco As Double, ByRef ccx As Double, ByRef GDD As Double, ByRef cdc As Double, ByRef tbase As Double, _
ByRef fsiemb As Double, ByRef fsieg As Double, ByRef humemer As Double, ByRef gdsenes As Double, ByRef dsingerm As Double, ByRef flagemer As Integer, _
ByRef pgcover As Double, ByRef kcbx As Double, ByRef fage As Double, ByRef tpotcover As Double, ByRef fraicub As Double, ByRef prfcubmax As Double, _
ByRef rcub As Double, ByRef realtcover As Double, ByRef praic As Double, ByRef opsieg As Double, ByRef marco As Double, ByRef percprof As Double, _
ByRef bulbpar As Double, ByRef ngot As Double, ByRef fgot As Double, ByRef indrieg As Double, ByRef hrieg As Double, ByRef tbvin As Double, _
ByRef BGDDV As Double, ByRef opraicvine As Double, ByRef opfmoist As Double, ByRef humfixed As Double)
Sub VABB00VBA() 'Es el modulo de interface con WABYN que esta compilado como DLL.
' DECLARACION DE VARIABLES
' -------------------------
Dim clima(1 To 730, 1 To 4) As Double, humeini(1 To 13, 1 To 3) As Double, humsal(1 To 13, 1 To 3) As Double
Dim ped(1 To 13, 1 To 3) As Double, hsat(1 To 13, 1 To 3) As Double, hfcap(1 To 13, 1 To 3) As Double, hpmp(1 To 13, 1 To 3) As Double
Dim hres(1 To 13, 1 To 3) As Double
Dim cn(1 To 3) As Double, cnres As Double, rit As Double, fracca As Double, profmax As Double, fracco As Double, fraccu As Double
Dim acolfrac(1 To 3) As Double, acolmat(1 To 3) As Double, tvine As Double
Dim f As Integer, c As Integer, m As Integer, indrieg As Double, GDDV(1 To 4) As Double, tbvin As Double
Dim salhyd(1 To 730, 1 To 8) As Double, humday(1 To 13, 1 To 3, 1 To 730) As Double
Dim marco As Double, supcub As Double, supcop As Double, calle As Double, intra As Double, anchcub As Double, dimoliv As Double
Dim ngot As Double, fgot As Double, hrieg(1 To 730) As Double, dosrieg(1 To 730) As Double, bulbpar(1 To 6) As Double
Dim dhyd(1 To 730, 1 To 8) As Double, dkp(1 To 3) As Double, dfrraol(1 To 13, 1 To 3) As Double
Dim fsiemb As Double, humemer As Double, fsieg As Double, cco As Double, ccx As Double, GDD As Double
Dim cdc As Double, tbase As Double, gdsenes As Double, pgcover(1 To 730) As Double, dsingerm As Double, flagemer As Integer
Dim tpotcover(1 To 730) As Double, kcbx As Double, fage As Double, prfcubmax As Double, frraicub(1 To 13) As Double
Dim realtcover(1 To 730) As Double, praic(1 To 730) As Double, rcub As Double, opsieg As Double, percprof(1 To 730) As Double
Dim opraicvine As Double, opfmoist As Double, humfixed(1 To 13, 1 To 3) As Double
Dim MatrixA As Variant, MatrixB As Variant, MatrixC As Variant, MatrixCA As Variant, cocub As Double, MatrixCB As Variant
Dim MatrixFRRAIOL As Variant, MatrixVKP As Variant, MatrixFRRAI As Variant, MatrixBULRIG As Variant
Dim MatrixDR As Variant, A As Variant, FH As Variant, IDAY As Variant
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
You absolutely need STDCALL for that, but must also make sure that every procedure argument in the Fortran routine has REFERENCE. You could also use:
!DEC$ ATTRIBUTES STDCALL, REFERENCE :: WABB00
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
My final post simply to confirm that now it works with your help.
Making sure that was compiled at 32 bits and adding the STDCALL solved this issue.
!DEC$ ATTRIBUTES STDCALL, REFERENCE :: WABB00
Thanks for all,
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Glad to hear it.

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page