From seecoolguy at gmail.com Thu Oct 1 11:01:08 2020 From: seecoolguy at gmail.com (SeeCool Guy) Date: Thu, 1 Oct 2020 09:01:08 -0700 Subject: [AccessD] SQL Server GUI tools In-Reply-To: References: <5F5809AB.22172.1114502B@stuart.lexacorp.com.pg> Message-ID: Hey John, There are a number of tools suggested here: https://www.comparitech.com/net-admin/best-database-diagram-tools/ btw, in my copy of 2017 ssms that option for diagrams has already been removed. more info: https://docs.microsoft.com/en-us/sql/sql-server/what-s-new-in-sql-server-ver15?view=sql-server-ver15 ? Francisco Tapia On Sep 18, 2020 at 1:28:16 PM, David McAfee wrote: > I might be wrong, but I think the diagrams are going away with SSMS 2019 > > Also, not sure if any of you know that Access reports can be converted > (imported) into SSRS RDLs using Visual Studio Community (free) and SSDT. > > I had a few reports that contained embedded sub reports which failed the > import process. > > I exported those into a new Access database then saved a version of the > main report without the embedded subreport. That new version imported fine > and I manually embedded the subreport rdl into the main rdl. > > On Tue, Sep 8, 2020, 3:46 PM Stuart McLachlan > wrote: > > In SQL Server Management Studio (using 2014) > > > In the Treeview: > > > Server > > ....Databases > > ......MyDatabase > > .........Database Diagrams > > > New Diagram (Unless you've got an aappropriate one already there) > > Add desired tables > > > Click on the "record selector" of a field in one table and drag it over a > > field in another table to > > create a relationship. You will be prompted for the reationsip details. > > > To delete a relationship, right click on the relationship and select > > "Delete relationships..." > > You wil be prompted for confirmation. > > > On 8 Sep 2020 at 21:26, John Bartow wrote: > > > > Since SQL Server was recently brought up... > > > > > > Is there a decent tool to graphically layout tables and relationships > > > similar to how the Access relationships dialog window works? > > > > > > John B > > > > > > > > > -- > > > AccessD mailing list > > > AccessD at databaseadvisors.com > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > Website: http://www.databaseadvisors.com > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From df.waters at outlook.com Thu Oct 1 12:13:15 2020 From: df.waters at outlook.com (Daniel Waters) Date: Thu, 1 Oct 2020 17:13:15 +0000 Subject: [AccessD] SQL Server GUI tools In-Reply-To: References: <5F5809AB.22172.1114502B@stuart.lexacorp.com.pg> , Message-ID: I found this: https://cloudblogs.microsoft.com/sqlserver/2019/06/11/sql-server-management-studio-ssms-18-1-is-now-generally-available/ SSMS 18.1 does now include diagrams! Dan From: SeeCool Guy Sent: Thursday, October 1, 2020 11:03 AM To: Access Developers discussion and problem solving Subject: Re: [AccessD] SQL Server GUI tools Hey John, There are a number of tools suggested here: https://www.comparitech.com/net-admin/best-database-diagram-tools/ btw, in my copy of 2017 ssms that option for diagrams has already been removed. more info: https://docs.microsoft.com/en-us/sql/sql-server/what-s-new-in-sql-server-ver15?view=sql-server-ver15 ? Francisco Tapia On Sep 18, 2020 at 1:28:16 PM, David McAfee wrote: > I might be wrong, but I think the diagrams are going away with SSMS 2019 > > Also, not sure if any of you know that Access reports can be converted > (imported) into SSRS RDLs using Visual Studio Community (free) and SSDT. > > I had a few reports that contained embedded sub reports which failed the > import process. > > I exported those into a new Access database then saved a version of the > main report without the embedded subreport. That new version imported fine > and I manually embedded the subreport rdl into the main rdl. > > On Tue, Sep 8, 2020, 3:46 PM Stuart McLachlan > wrote: > > In SQL Server Management Studio (using 2014) > > > In the Treeview: > > > Server > > ....Databases > > ......MyDatabase > > .........Database Diagrams > > > New Diagram (Unless you've got an aappropriate one already there) > > Add desired tables > > > Click on the "record selector" of a field in one table and drag it over a > > field in another table to > > create a relationship. You will be prompted for the reationsip details. > > > To delete a relationship, right click on the relationship and select > > "Delete relationships..." > > You wil be prompted for confirmation. > > > On 8 Sep 2020 at 21:26, John Bartow wrote: > > > > Since SQL Server was recently brought up... > > > > > > Is there a decent tool to graphically layout tables and relationships > > > similar to how the Access relationships dialog window works? > > > > > > John B > > > > > > > > > -- > > > AccessD mailing list > > > AccessD at databaseadvisors.com > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > Website: http://www.databaseadvisors.com > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From seecoolguy at gmail.com Thu Oct 1 14:03:26 2020 From: seecoolguy at gmail.com (SeeCool Guy) Date: Thu, 1 Oct 2020 12:03:26 -0700 Subject: [AccessD] SQL Server GUI tools In-Reply-To: References: <5F5809AB.22172.1114502B@stuart.lexacorp.com.pg> , Message-ID: Nice! On Oct 1, 2020 at 10:13:15 AM, Daniel Waters wrote: > I found this: > > > https://cloudblogs.microsoft.com/sqlserver/2019/06/11/sql-server-management-studio-ssms-18-1-is-now-generally-available/ > > SSMS 18.1 does now include diagrams! > > Dan > > From: SeeCool Guy > Sent: Thursday, October 1, 2020 11:03 AM > To: Access Developers discussion and problem solving accessd at databaseadvisors.com> > Subject: Re: [AccessD] SQL Server GUI tools > > Hey John, > > There are a number of tools suggested here: > https://www.comparitech.com/net-admin/best-database-diagram-tools/ > > btw, in my copy of 2017 ssms that option for diagrams has already been > removed. > > more info: > > https://docs.microsoft.com/en-us/sql/sql-server/what-s-new-in-sql-server-ver15?view=sql-server-ver15 > > ? > Francisco Tapia > > On Sep 18, 2020 at 1:28:16 PM, David McAfee wrote: > > I might be wrong, but I think the diagrams are going away with SSMS 2019 > > > Also, not sure if any of you know that Access reports can be converted > > (imported) into SSRS RDLs using Visual Studio Community (free) and SSDT. > > > I had a few reports that contained embedded sub reports which failed the > > import process. > > > I exported those into a new Access database then saved a version of the > > main report without the embedded subreport. That new version imported fine > > and I manually embedded the subreport rdl into the main rdl. > > > On Tue, Sep 8, 2020, 3:46 PM Stuart McLachlan > > wrote: > > > In SQL Server Management Studio (using 2014) > > > > In the Treeview: > > > > Server > > > ....Databases > > > ......MyDatabase > > > .........Database Diagrams > > > > New Diagram (Unless you've got an aappropriate one already there) > > > Add desired tables > > > > Click on the "record selector" of a field in one table and drag it over a > > > field in another table to > > > create a relationship. You will be prompted for the reationsip details. > > > > To delete a relationship, right click on the relationship and select > > > "Delete relationships..." > > > You wil be prompted for confirmation. > > > > On 8 Sep 2020 at 21:26, John Bartow wrote: > > > > > Since SQL Server was recently brought up... > > > > > > > > Is there a decent tool to graphically layout tables and relationships > > > > similar to how the Access relationships dialog window works? > > > > > > > > John B > > > > > > > > > > > > -- > > > > AccessD mailing list > > > > AccessD at databaseadvisors.com > > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > > Website: http://www.databaseadvisors.com > > > > > > > > > -- > > > AccessD mailing list > > > AccessD at databaseadvisors.com > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > Website: http://www.databaseadvisors.com > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From stuart at lexacorp.com.pg Thu Oct 1 16:26:43 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 02 Oct 2020 07:26:43 +1000 Subject: [AccessD] SQL Server GUI tools In-Reply-To: References: , , Message-ID: <5F764993.5205.E252A73@stuart.lexacorp.com.pg> Yep,"someone" in MS messed up big time over that one. :-) They took it out in ver 18.0 and put it back in 18.1 On 1 Oct 2020 at 17:13, Daniel Waters wrote: > I found this: > > https://cloudblogs.microsoft.com/sqlserver/2019/06/11/sql-server-manag > ement-studio-ssms-18-1-is-now-generally-available/ > > SSMS 18.1 does now include diagrams! > > Dan > > From: SeeCool Guy > Sent: Thursday, October 1, 2020 11:03 AM > To: Access Developers discussion and problem > solving Subject: Re: [AccessD] > SQL Server GUI tools > > Hey John, > > There are a number of tools suggested here: > https://www.comparitech.com/net-admin/best-database-diagram-tools/ > > btw, in my copy of 2017 ssms that option for diagrams has already been > removed. > > more info: > https://docs.microsoft.com/en-us/sql/sql-server/what-s-new-in-sql-serv > er-ver15?view=sql-server-ver15 > > - > Francisco Tapia > > On Sep 18, 2020 at 1:28:16 PM, David McAfee > wrote: > > > I might be wrong, but I think the diagrams are going away with SSMS > > 2019 > > > > Also, not sure if any of you know that Access reports can be > > converted (imported) into SSRS RDLs using Visual Studio Community > > (free) and SSDT. > > > > I had a few reports that contained embedded sub reports which failed > > the import process. > > > > I exported those into a new Access database then saved a version of > > the main report without the embedded subreport. That new version > > imported fine and I manually embedded the subreport rdl into the > > main rdl. > > > > On Tue, Sep 8, 2020, 3:46 PM Stuart McLachlan > > wrote: > > > > In SQL Server Management Studio (using 2014) > > > > > > In the Treeview: > > > > > > Server > > > > ....Databases > > > > ......MyDatabase > > > > .........Database Diagrams > > > > > > New Diagram (Unless you've got an aappropriate one already there) > > > > Add desired tables > > > > > > Click on the "record selector" of a field in one table and drag it > > over a > > > > field in another table to > > > > create a relationship. You will be prompted for the reationsip > > details. > > > > > > To delete a relationship, right click on the relationship and select > > > > "Delete relationships..." > > > > You wil be prompted for confirmation. > > > > > > On 8 Sep 2020 at 21:26, John Bartow wrote: > > > > > > > Since SQL Server was recently brought up... > > > > > > > > > > Is there a decent tool to graphically layout tables and > > > relationships > > > > > similar to how the Access relationships dialog window works? > > > > > > > > > > John B > > > > > > > > > > > > > > > -- > > > > > AccessD mailing list > > > > > AccessD at databaseadvisors.com > > > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > > > Website: http://www.databaseadvisors.com > > > > > > > > > > > > > -- > > > > AccessD mailing list > > > > AccessD at databaseadvisors.com > > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > > Website: http://www.databaseadvisors.com > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From stuart at lexacorp.com.pg Thu Oct 1 16:38:24 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 02 Oct 2020 07:38:24 +1000 Subject: [AccessD] SQL Server GUI tools In-Reply-To: <5F764993.5205.E252A73@stuart.lexacorp.com.pg> References: , , <5F764993.5205.E252A73@stuart.lexacorp.com.pg> Message-ID: <5F764C50.23754.E2FDAED@stuart.lexacorp.com.pg> Be aware that SSMS ver18.1 to 18.5 Database Diagrams apparently were buggy. https://docs.microsoft.com/en-us/sql/ssms/release-notes-ssms?view=sql-server-2017#ssms- 180-preview---cumulative-changelog-through-preview-6 Currently says: SSMS 18.6 is the latest general availability (GA) release of SSMS. ... Fixed long outstanding issue with Database Diagrams, causing both the corruption of existing diagrams and SSMS to crash. If you created or saved a diagram using SSMS 18.0 through 18.5.1, and that diagram includes a Text Annotation, you won't be able to open that diagram in any version of SSMS. With this fix, SSMS 18.6 can open and save a diagram created by SSMS 17.9.1 and prior. SSMS 17.9.1 and previous releases can also open the diagram after being saved by SSMS 18.6. (Note that the content of the URL above is liable to change at any time as they release updates.) On 2 Oct 2020 at 7:26, Stuart McLachlan wrote: > Yep,"someone" in MS messed up big time over that one. :-) > > They took it out in ver 18.0 and put it back in 18.1 > > > On 1 Oct 2020 at 17:13, Daniel Waters wrote: > > > I found this: > > > > https://cloudblogs.microsoft.com/sqlserver/2019/06/11/sql-server-man > > ag ement-studio-ssms-18-1-is-now-generally-available/ > > > > SSMS 18.1 does now include diagrams! > > > > Dan > > > > From: SeeCool Guy > > Sent: Thursday, October 1, 2020 11:03 AM > > To: Access Developers discussion and problem > > solving Subject: Re: [AccessD] > > SQL Server GUI tools > > > > Hey John, > > > > There are a number of tools suggested here: > > https://www.comparitech.com/net-admin/best-database-diagram-tools/ > > > > btw, in my copy of 2017 ssms that option for diagrams has already > > been removed. > > > > more info: > > https://docs.microsoft.com/en-us/sql/sql-server/what-s-new-in-sql-se > > rv er-ver15?view=sql-server-ver15 > > > > - > > Francisco Tapia > > > > On Sep 18, 2020 at 1:28:16 PM, David McAfee > > wrote: > > > > > I might be wrong, but I think the diagrams are going away with > > > SSMS 2019 > > > > > > Also, not sure if any of you know that Access reports can be > > > converted (imported) into SSRS RDLs using Visual Studio Community > > > (free) and SSDT. > > > > > > I had a few reports that contained embedded sub reports which > > > failed the import process. > > > > > > I exported those into a new Access database then saved a version > > > of the main report without the embedded subreport. That new > > > version imported fine and I manually embedded the subreport rdl > > > into the main rdl. > > > > > > On Tue, Sep 8, 2020, 3:46 PM Stuart McLachlan > > > wrote: > > > > > > In SQL Server Management Studio (using 2014) > > > > > > > > > In the Treeview: > > > > > > > > > Server > > > > > > ....Databases > > > > > > ......MyDatabase > > > > > > .........Database Diagrams > > > > > > > > > New Diagram (Unless you've got an aappropriate one already there) > > > > > > Add desired tables > > > > > > > > > Click on the "record selector" of a field in one table and drag it > > > over a > > > > > > field in another table to > > > > > > create a relationship. You will be prompted for the reationsip > > > details. > > > > > > > > > To delete a relationship, right click on the relationship and > > > select > > > > > > "Delete relationships..." > > > > > > You wil be prompted for confirmation. > > > > > > > > > On 8 Sep 2020 at 21:26, John Bartow wrote: > > > > > > > > > > Since SQL Server was recently brought up... > > > > > > > > > > > > > > Is there a decent tool to graphically layout tables and > > > > relationships > > > > > > > similar to how the Access relationships dialog window works? > > > > > > > > > > > > > > John B > > > > > > > > > > > > > > > > > > > > > -- > > > > > > > AccessD mailing list > > > > > > > AccessD at databaseadvisors.com > > > > > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > > > > > Website: http://www.databaseadvisors.com > > > > > > > > > > > > > > > > > > > -- > > > > > > AccessD mailing list > > > > > > AccessD at databaseadvisors.com > > > > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > > > > Website: http://www.databaseadvisors.com > > > > > > > > > -- > > > AccessD mailing list > > > AccessD at databaseadvisors.com > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > Website: http://www.databaseadvisors.com > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From jwcolby at gmail.com Fri Oct 2 19:52:29 2020 From: jwcolby at gmail.com (John Colby) Date: Fri, 2 Oct 2020 20:52:29 -0400 Subject: [AccessD] RTOS for you? Message-ID: https://arstechnica.com/features/2020/10/the-space-operating-systems-booting-up-where-no-one-has-gone-before/ -- John W. Colby Colby Consulting From gustav at cactus.dk Sat Oct 3 02:02:02 2020 From: gustav at cactus.dk (Gustav Brock) Date: Sat, 3 Oct 2020 07:02:02 +0000 Subject: [AccessD] RTOS for you? In-Reply-To: References: Message-ID: Hi John Very interesting. Thanks! /gustav ________________________________ Fra: AccessD p? vegne af John Colby Sendt: 3. oktober 2020 02:52 Til: Access Developers discussion and problem solving Emne: [AccessD] RTOS for you? https://arstechnica.com/features/2020/10/the-space-operating-systems-booting-up-where-no-one-has-gone-before/ -- John W. Colby Colby Consulting -- From jwcolby at gmail.com Tue Oct 6 14:42:34 2020 From: jwcolby at gmail.com (John Colby) Date: Tue, 6 Oct 2020 15:42:34 -0400 Subject: [AccessD] =?utf-8?q?Custom-made_UEFI_bootkit_found_lurking_in_the?= =?utf-8?q?_wild_=E2=80=93_Ars_Technica?= Message-ID: https://arstechnica.com/information-technology/2020/10/custom-made-uefi-bootkit-found-lurking-in-the-wild/ From jamesbutton at blueyonder.co.uk Tue Oct 6 17:04:38 2020 From: jamesbutton at blueyonder.co.uk (James Button) Date: Tue, 6 Oct 2020 23:04:38 +0100 Subject: [AccessD] Custom-made UEFI bootkit found lurking in the wild - Ars Technica In-Reply-To: References: Message-ID: John, Thanks for that But you're 25 days early for Halloween. And does that actually cap the older kids wearing a dark but cheap suit, and carrying a case with the logo "IRS" printed on it. With the really frightening IT thing being the sheer number of systems sold ready setup. As in, even in corporate environments - an OS installed, and even with the box opened and resealed pre-delivery. also, who nowadays even looks to see what is in the system startup, let alone would notice unexpected code, as in something they know should not be there as part of the OS. OK - hard drives could have 'stuff' on the surface outside of the LBA.s assignable as partitions Time machines included drivers that way - the restore doing direct reads of the drive for drivers as indicated in the .txt system description file. Also there is the unused space in the bootblock, and the system partition. Are similar exploits possible on SSD devices ? And - as I recently found - an OS update from Microsoft had reset my system's action-on-detection of plugged-in device from ask and explorer to autoplay (run the preset program). JimB -----Original Message----- From: AccessD On Behalf Of John Colby Sent: Tuesday, October 6, 2020 8:43 PM To: Access Developers discussion and problem solving Subject: [AccessD] Custom-made UEFI bootkit found lurking in the wild - Ars Technica https://arstechnica.com/information-technology/2020/10/custom-made-uefi-bootkit- found-lurking-in-the-wild/ -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From jimdettman at verizon.net Tue Oct 6 17:37:54 2020 From: jimdettman at verizon.net (Jim Dettman) Date: Tue, 6 Oct 2020 18:37:54 -0400 Subject: [AccessD] Custom-made UEFI bootkit found lurking in the wild - Ars Technica In-Reply-To: References: Message-ID: <050901d69c31$553beed0$ffb3cc70$@verizon.net> Wonder if there are some un-happy folks over at the NSA. Jim. -----Original Message----- From: AccessD On Behalf Of John Colby Sent: Tuesday, October 6, 2020 3:43 PM To: Access Developers discussion and problem solving Subject: [AccessD] Custom-made UEFI bootkit found lurking in the wild - Ars Technica https://arstechnica.com/information-technology/2020/10/custom-made-uefi-boot kit-found-lurking-in-the-wild/ -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From newsgrps at dalyn.co.nz Fri Oct 9 02:33:57 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 20:33:57 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <5EB1F9DE.28205.2B117E1@stuart.lexacorp.com.pg> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz> <5EB1F9DE.28205.2B117E1@stuart.lexacorp.com.pg> Message-ID: <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz> Hi Stuart (and others), I am working on your code below. I am initially checking that I can ping to the server using the InternetOK() function but I am getting an error: Ping request could not find host sftp://sftp.electricityregistry.co.nz. Please check the name and try again. Here is my modified Code (without error coding): Function InternetOK() As Boolean Dim strTemp As String, strExe As String, ff As Long strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = Environ("COMSPEC") & " /c " strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request could not find host") > 0 Then InternetOK = False Else InternetOK = True End If End Function I am able to connect using FileZilla. But this includes a login and password. Can anyone suggest what I am doing wrong? Regards David Emerson Dalyn Software Ltd Wellington, New Zealand -----Original Message----- From: AccessD On Behalf Of Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access Developers discussion and problem solving Subject: Re: [AccessD] Transferring Files via FTP Heres' a modFTP from an old application of mine which uses the built in Windows FTP client and an FTP script generated "on the fly". It will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. (These days, I SHELL to my own applicationa written in PowerBASIC for all FPT processes) Option Explicit Option Compare Database Private Const STARTF_USESHOWWINDOW& = &H1 Private Const NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& Public g_strFTPPutList() As String Private Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) On Error GoTo Err_Handler Dim proc As PROCESS_INFORMATION Dim start As STARTUPINFO Dim ret As Long ' Initialize the STARTUPINFO structure: With start .cb = Len(start) If Not IsMissing(WindowStyle) Then .dwFlags = STARTF_USESHOWWINDOW .wShowWindow = WindowStyle End If End With ' Start the shelled application: ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc) ' Wait for the shelled application to finish: ret& = WaitForSingleObject(proc.hProcess, INFINITE) ret& = CloseHandle(proc.hProcess) Exit_Here: Exit Sub Err_Handler: MsgBox Err.Description, vbExclamation, "E R R O R" Resume Exit_Here End Sub 'Following functions look for Site, Login, PW in table usysWeb Function ListFTPFiles(Directory As String) As Variant Const q As String * 1 = """" Dim sEXE As String Dim strList As String Dim strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & "webfiles.txt" For Input As #ff While Not EOF(ff) x = x + 1 ReDim Preserve strFIles(x) Line Input #1, strFIles(x) Wend Close #ff 'Kill TempDir() & "webfiles.txt" ListFTPFiles = strFIles() End Function Function FTPPut(Directory As String, Filename As String) As Boolean Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As String Dim strFName As String Dim strList As String Dim ff As Long If Dir(Filename) = "" Then MsgBox Filename & " not found!" Exit Function End If strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End Function Function FTPGet(Filename As String, LocalDirectory As String) As Boolean Const q As String * 1 = """" Dim strExe As String Dim strFTPDir As String Dim strFName As String Dim strList As String Dim ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then MsgBox LocalDirectory & " not found" Exit Function End If strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide Kill strList End Function Function InternetOK() As Boolean Dim strTemp As String Dim strExe As String Dim ff As Long strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = Environ("COMSPEC") & " /c " strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request could not find host") > 0 Then InternetOK = False Else InternetOK = True End If End Function Function FTPPutList(FileList() As String) As Boolean 'FileList Array is 0 based Row(0) is blank. ' Subsequent rows formatted as: RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As String Dim strLocalDirStore As String Dim strRemoteDirStore As String Dim strFileName As String Dim strList As String Dim strCmds As String Dim ff As Long Dim x As Long Dim strPut() As String strCmds = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "binary" For x = 1 To UBound(FileList()) strPut() = Split(FileList(x), Chr$(9)) strRemoteDir = strPut(0) strLocalDir = strPut(1) strFileName = strPut(2) If strRemoteDir <> strRemoteDirStore Then Print #ff, "cd " & strRemoteDir strRemoteDirStore = strRemoteDir End If If strLocalDir <> strLocalDirStore Then Print #ff, "lcd " & strLocalDir strLocalDirStore = strLocalDir End If If Dir(strLocalDir & strFileName) = "" Then MsgBox strLocalDir & strFileName & " not found!" Exit Function End If Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function ---------------------- END OF modFTP modFTP also uses this Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Public Function TempDir() As String Dim strPath As String strPath = Space(MAX_PATH) GetTempPath Len(strPath), strPath TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End Function On 6 May 2020 at 11:07, David Emerson wrote: > Hi Listers, > > > > I hope everyone is keeping safe. > > > > Can anyone give me recommendations for code/software so that I can log > into a secure FTP site using a username and password, and upload and > download files via vba? > > > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand From newsgrps at dalyn.co.nz Fri Oct 9 02:43:41 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 20:43:41 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz> <5EB1F9DE.28205.2B117E1@stuart.lexacorp.com.pg> <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz> Message-ID: <003701d69e0f$ead39080$c07ab180$@dalyn.co.nz> Solved that one by using the IP address instead of the server name. -----Original Message----- From: AccessD On Behalf Of David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access Developers discussion and problem solving' Subject: Re: [AccessD] Transferring Files via FTP Hi Stuart (and others), I am working on your code below. I am initially checking that I can ping to the server using the InternetOK() function but I am getting an error: Ping request could not find host sftp://sftp.electricityregistry.co.nz. Please check the name and try again. Here is my modified Code (without error coding): Function InternetOK() As Boolean Dim strTemp As String, strExe As String, ff As Long strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = Environ("COMSPEC") & " /c " strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request could not find host") > 0 Then InternetOK = False Else InternetOK = True End If End Function I am able to connect using FileZilla. But this includes a login and password. Can anyone suggest what I am doing wrong? Regards David Emerson Dalyn Software Ltd Wellington, New Zealand -----Original Message----- From: AccessD On Behalf Of Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access Developers discussion and problem solving Subject: Re: [AccessD] Transferring Files via FTP Heres' a modFTP from an old application of mine which uses the built in Windows FTP client and an FTP script generated "on the fly". It will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. (These days, I SHELL to my own applicationa written in PowerBASIC for all FPT processes) Option Explicit Option Compare Database Private Const STARTF_USESHOWWINDOW& = &H1 Private Const NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& Public g_strFTPPutList() As String Private Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) On Error GoTo Err_Handler Dim proc As PROCESS_INFORMATION Dim start As STARTUPINFO Dim ret As Long ' Initialize the STARTUPINFO structure: With start .cb = Len(start) If Not IsMissing(WindowStyle) Then .dwFlags = STARTF_USESHOWWINDOW .wShowWindow = WindowStyle End If End With ' Start the shelled application: ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc) ' Wait for the shelled application to finish: ret& = WaitForSingleObject(proc.hProcess, INFINITE) ret& = CloseHandle(proc.hProcess) Exit_Here: Exit Sub Err_Handler: MsgBox Err.Description, vbExclamation, "E R R O R" Resume Exit_Here End Sub 'Following functions look for Site, Login, PW in table usysWeb Function ListFTPFiles(Directory As String) As Variant Const q As String * 1 = """" Dim sEXE As String Dim strList As String Dim strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & "webfiles.txt" For Input As #ff While Not EOF(ff) x = x + 1 ReDim Preserve strFIles(x) Line Input #1, strFIles(x) Wend Close #ff 'Kill TempDir() & "webfiles.txt" ListFTPFiles = strFIles() End Function Function FTPPut(Directory As String, Filename As String) As Boolean Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As String Dim strFName As String Dim strList As String Dim ff As Long If Dir(Filename) = "" Then MsgBox Filename & " not found!" Exit Function End If strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End Function Function FTPGet(Filename As String, LocalDirectory As String) As Boolean Const q As String * 1 = """" Dim strExe As String Dim strFTPDir As String Dim strFName As String Dim strList As String Dim ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then MsgBox LocalDirectory & " not found" Exit Function End If strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide Kill strList End Function Function InternetOK() As Boolean Dim strTemp As String Dim strExe As String Dim ff As Long strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = Environ("COMSPEC") & " /c " strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request could not find host") > 0 Then InternetOK = False Else InternetOK = True End If End Function Function FTPPutList(FileList() As String) As Boolean 'FileList Array is 0 based Row(0) is blank. ' Subsequent rows formatted as: RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As String Dim strLocalDirStore As String Dim strRemoteDirStore As String Dim strFileName As String Dim strList As String Dim strCmds As String Dim ff As Long Dim x As Long Dim strPut() As String strCmds = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "binary" For x = 1 To UBound(FileList()) strPut() = Split(FileList(x), Chr$(9)) strRemoteDir = strPut(0) strLocalDir = strPut(1) strFileName = strPut(2) If strRemoteDir <> strRemoteDirStore Then Print #ff, "cd " & strRemoteDir strRemoteDirStore = strRemoteDir End If If strLocalDir <> strLocalDirStore Then Print #ff, "lcd " & strLocalDir strLocalDirStore = strLocalDir End If If Dir(strLocalDir & strFileName) = "" Then MsgBox strLocalDir & strFileName & " not found!" Exit Function End If Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function ---------------------- END OF modFTP modFTP also uses this Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Public Function TempDir() As String Dim strPath As String strPath = Space(MAX_PATH) GetTempPath Len(strPath), strPath TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End Function On 6 May 2020 at 11:07, David Emerson wrote: > Hi Listers, > > > > I hope everyone is keeping safe. > > > > Can anyone give me recommendations for code/software so that I can log > into a secure FTP site using a username and password, and upload and > download files via vba? > > > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From stuart at lexacorp.com.pg Fri Oct 9 02:55:57 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 09 Oct 2020 17:55:57 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <003701d69e0f$ead39080$c07ab180$@dalyn.co.nz> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz>, <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz>, <003701d69e0f$ead39080$c07ab180$@dalyn.co.nz> Message-ID: <5F80178D.7885.71D23E@stuart.lexacorp.com.pg> Yep, you should not have put the protocol in front of the host name PING sftp.electricityregistry.co.nz not PING sftp://sftp.electricityregistry.co.nz On 9 Oct 2020 at 20:43, David Emerson wrote: > Solved that one by using the IP address instead of the server name. > > -----Original Message----- > From: AccessD On Behalf Of > David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access > Developers discussion and problem solving' > Subject: Re: [AccessD] Transferring > Files via FTP > > Hi Stuart (and others), > > I am working on your code below. I am initially checking that I can > ping to the server using the InternetOK() function but I am getting an > error: Ping request could not find host > sftp://sftp.electricityregistry.co.nz. Please check the name and try > again. > > Here is my modified Code (without error coding): > > Function InternetOK() As Boolean > > Dim strTemp As String, strExe As String, ff As Long > > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > > """ > & TempDir() & "pingtest.txt""" > ShellWait strExe, vbHide > > Debug.Print strExe > ff = FreeFile > Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp > Close #ff > If InStr(strTemp, "Ping request could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > I am able to connect using FileZilla. But this includes a login and > password. > > Can anyone suggest what I am doing wrong? > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand > > > > -----Original Message----- > From: AccessD On Behalf Of > Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access > Developers discussion and problem solving > Subject: Re: [AccessD] Transferring > Files via FTP > > Heres' a modFTP from an old application of mine which uses the built > in Windows FTP client and an FTP script generated "on the fly". It > will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. > > (These days, I SHELL to my own applicationa written in PowerBASIC > for all FPT processes) > > > Option Explicit > Option Compare Database > > Private Const STARTF_USESHOWWINDOW& = &H1 Private Const > NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& > > Public g_strFTPPutList() As String > > Private Type STARTUPINFO > cb As Long > lpReserved As String > lpDesktop As String > lpTitle As String > dwX As Long > dwY As Long > dwXSize As Long > dwYSize As Long > dwXCountChars As Long > dwYCountChars As Long > dwFillAttribute As Long > dwFlags As Long > wShowWindow As Integer > cbReserved2 As Integer > lpReserved2 As Long > hStdInput As Long > hStdOutput As Long > hStdError As Long > End Type > > Private Type PROCESS_INFORMATION > hProcess As Long > hThread As Long > dwProcessID As Long > dwThreadID As Long > End Type > > Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As > Long, ByVal dwMilliseconds As Long) As Long > > Declare Function CreateProcessA Lib "kernel32" (ByVal > lpApplicationName As Long, ByVal lpCommandLine As String, ByVal > lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal > bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal > lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo > As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long > > Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As > Long > > Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) > On Error GoTo Err_Handler > > Dim proc As PROCESS_INFORMATION > Dim start As STARTUPINFO > Dim ret As Long > > ' Initialize the STARTUPINFO structure: > With start > .cb = Len(start) > If Not IsMissing(WindowStyle) Then > .dwFlags = STARTF_USESHOWWINDOW > .wShowWindow = WindowStyle > End If > End With > ' Start the shelled application: > ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, > NORMAL_PRIORITY_CLASS, > 0&, 0&, start, proc) > ' Wait for the shelled application to finish: > ret& = WaitForSingleObject(proc.hProcess, INFINITE) > ret& = CloseHandle(proc.hProcess) > > Exit_Here: > Exit Sub > Err_Handler: > MsgBox Err.Description, vbExclamation, "E R R O R" > Resume Exit_Here > > End Sub > > > 'Following functions look for Site, Login, PW in table usysWeb > Function ListFTPFiles(Directory As String) As Variant Const q As > String * 1 = """" Dim sEXE As String Dim strList As String Dim > strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() > & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print > #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print > #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, > Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList > & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & > "webfiles.txt" For Input As #ff While Not EOF(ff) > x = x + 1 > ReDim Preserve strFIles(x) > Line Input #1, strFIles(x) > Wend > Close #ff > 'Kill TempDir() & "webfiles.txt" > ListFTPFiles = strFIles() > End Function > > Function FTPPut(Directory As String, Filename As String) As Boolean > Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As > String Dim strFName As String Dim strList As String Dim ff As Long If > Dir(Filename) = "" Then > MsgBox Filename & " not found!" > Exit Function > End If > strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If > Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" > strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print > #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End > Function > > Function FTPGet(Filename As String, LocalDirectory As String) As > Boolean Const q As String * 1 = """" Dim strExe As String Dim > strFTPDir As String Dim strFName As String Dim strList As String Dim > ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then > MsgBox LocalDirectory & " not found" > Exit Function > End If > strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = > Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & > "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, > "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print > #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = > Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - > Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q > ShellWait strExe, vbHide Kill strList End Function > > Function InternetOK() As Boolean > Dim strTemp As String > Dim strExe As String > Dim ff As Long > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ > & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print > strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request > could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > Function FTPPutList(FileList() As String) As Boolean 'FileList Array > is 0 based Row(0) is blank. ' Subsequent rows formatted as: > RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" > Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As > String Dim strLocalDirStore As String Dim strRemoteDirStore As String > Dim strFileName As String Dim strList As String Dim strCmds As String > Dim ff As Long Dim x As Long Dim strPut() As String strCmds = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "binary" > > For x = 1 To UBound(FileList()) > strPut() = Split(FileList(x), Chr$(9)) > strRemoteDir = strPut(0) > strLocalDir = strPut(1) > strFileName = strPut(2) > > If strRemoteDir <> strRemoteDirStore Then > Print #ff, "cd " & strRemoteDir > strRemoteDirStore = strRemoteDir > End If > > If strLocalDir <> strLocalDirStore Then > Print #ff, "lcd " & strLocalDir > strLocalDirStore = strLocalDir > End If > > If Dir(strLocalDir & strFileName) = "" Then > MsgBox strLocalDir & strFileName & " not found!" > Exit Function > End If > > Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function > ---------------------- END OF modFTP > > modFTP also uses this > > Private Declare Function GetTempPath Lib "kernel32" Alias > "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As > String) As Long > > Public Function TempDir() As String > Dim strPath As String > strPath = Space(MAX_PATH) > GetTempPath Len(strPath), strPath > TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End > Function > > > > On 6 May 2020 at 11:07, David Emerson wrote: > > > Hi Listers, > > > > > > > > I hope everyone is keeping safe. > > > > > > > > Can anyone give me recommendations for code/software so that I can > > log into a secure FTP site using a username and password, and > > upload and download files via vba? > > > > > > > > Regards > > > > David Emerson > > Dalyn Software Ltd > > Wellington, New Zealand > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From newsgrps at dalyn.co.nz Fri Oct 9 03:08:12 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 21:08:12 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz> <5EB1F9DE.28205.2B117E1@stuart.lexacorp.com.pg> <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz> Message-ID: <003801d69e13$57938060$06ba8120$@dalyn.co.nz> Spoke too soon. Now the Ping message is: Pinging 143.96.3.34 with 32 bytes of data: Request timed out. Ping statistics for 143.96.3.34: Packets: Sent = 1, Received = 0, Lost = 1 (100% loss), I have increased the wait time to 60 seconds but still with the same result. Here is the ping command: C:\Windows\system32\cmd.exe /c ping 143.96.3.34 -n 1 -w 60000 > "C:\aaTemp\pingtest.txt" However, I cannot connect with FileZilla using the IP Address. It only seems to work with sftp://sftp.electricityregistry.co.nz (and connects within a couple of seconds). In summary, Pinging the server name gets: Ping request could not find host sftp://sftp.electricityregistry.co.nz. Pinging the server IP gets: Request timed out. Connecting via FileZilla using the server name (and login) works. What is my code missing? Regards David Emerson Dalyn Software Ltd Wellington, New Zealand -----Original Message----- From: AccessD On Behalf Of David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access Developers discussion and problem solving' Subject: Re: [AccessD] Transferring Files via FTP Hi Stuart (and others), I am working on your code below. I am initially checking that I can ping to the server using the InternetOK() function but I am getting an error: Ping request could not find host sftp://sftp.electricityregistry.co.nz. Please check the name and try again. Here is my modified Code (without error coding): Function InternetOK() As Boolean Dim strTemp As String, strExe As String, ff As Long strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = Environ("COMSPEC") & " /c " strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request could not find host") > 0 Then InternetOK = False Else InternetOK = True End If End Function I am able to connect using FileZilla. But this includes a login and password. Can anyone suggest what I am doing wrong? Regards David Emerson Dalyn Software Ltd Wellington, New Zealand -----Original Message----- From: AccessD On Behalf Of Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access Developers discussion and problem solving Subject: Re: [AccessD] Transferring Files via FTP Heres' a modFTP from an old application of mine which uses the built in Windows FTP client and an FTP script generated "on the fly". It will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. (These days, I SHELL to my own applicationa written in PowerBASIC for all FPT processes) Option Explicit Option Compare Database Private Const STARTF_USESHOWWINDOW& = &H1 Private Const NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& Public g_strFTPPutList() As String Private Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Long hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessID As Long dwThreadID As Long End Type Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) On Error GoTo Err_Handler Dim proc As PROCESS_INFORMATION Dim start As STARTUPINFO Dim ret As Long ' Initialize the STARTUPINFO structure: With start .cb = Len(start) If Not IsMissing(WindowStyle) Then .dwFlags = STARTF_USESHOWWINDOW .wShowWindow = WindowStyle End If End With ' Start the shelled application: ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc) ' Wait for the shelled application to finish: ret& = WaitForSingleObject(proc.hProcess, INFINITE) ret& = CloseHandle(proc.hProcess) Exit_Here: Exit Sub Err_Handler: MsgBox Err.Description, vbExclamation, "E R R O R" Resume Exit_Here End Sub 'Following functions look for Site, Login, PW in table usysWeb Function ListFTPFiles(Directory As String) As Variant Const q As String * 1 = """" Dim sEXE As String Dim strList As String Dim strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & "webfiles.txt" For Input As #ff While Not EOF(ff) x = x + 1 ReDim Preserve strFIles(x) Line Input #1, strFIles(x) Wend Close #ff 'Kill TempDir() & "webfiles.txt" ListFTPFiles = strFIles() End Function Function FTPPut(Directory As String, Filename As String) As Boolean Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As String Dim strFName As String Dim strList As String Dim ff As Long If Dir(Filename) = "" Then MsgBox Filename & " not found!" Exit Function End If strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End Function Function FTPGet(Filename As String, LocalDirectory As String) As Boolean Const q As String * 1 = """" Dim strExe As String Dim strFTPDir As String Dim strFName As String Dim strList As String Dim ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then MsgBox LocalDirectory & " not found" Exit Function End If strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide Kill strList End Function Function InternetOK() As Boolean Dim strTemp As String Dim strExe As String Dim ff As Long strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = Environ("COMSPEC") & " /c " strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request could not find host") > 0 Then InternetOK = False Else InternetOK = True End If End Function Function FTPPutList(FileList() As String) As Boolean 'FileList Array is 0 based Row(0) is blank. ' Subsequent rows formatted as: RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As String Dim strLocalDirStore As String Dim strRemoteDirStore As String Dim strFileName As String Dim strList As String Dim strCmds As String Dim ff As Long Dim x As Long Dim strPut() As String strCmds = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "binary" For x = 1 To UBound(FileList()) strPut() = Split(FileList(x), Chr$(9)) strRemoteDir = strPut(0) strLocalDir = strPut(1) strFileName = strPut(2) If strRemoteDir <> strRemoteDirStore Then Print #ff, "cd " & strRemoteDir strRemoteDirStore = strRemoteDir End If If strLocalDir <> strLocalDirStore Then Print #ff, "lcd " & strLocalDir strLocalDirStore = strLocalDir End If If Dir(strLocalDir & strFileName) = "" Then MsgBox strLocalDir & strFileName & " not found!" Exit Function End If Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function ---------------------- END OF modFTP modFTP also uses this Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Public Function TempDir() As String Dim strPath As String strPath = Space(MAX_PATH) GetTempPath Len(strPath), strPath TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End Function On 6 May 2020 at 11:07, David Emerson wrote: > Hi Listers, > > > > I hope everyone is keeping safe. > > > > Can anyone give me recommendations for code/software so that I can log > into a secure FTP site using a username and password, and upload and > download files via vba? > > > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From newsgrps at dalyn.co.nz Fri Oct 9 03:13:56 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 21:13:56 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <5F80178D.7885.71D23E@stuart.lexacorp.com.pg> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz>, <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz>, <003701d69e0f$ead39080$c07ab180$@dalyn.co.nz> <5F80178D.7885.71D23E@stuart.lexacorp.com.pg> Message-ID: <003b01d69e14$2430a2b0$6c91e810$@dalyn.co.nz> Hi Stuart, I tried that. Here is the strExe string: C:\Windows\system32\cmd.exe /c ping sftp.electricityregistry.co.nz -n 1 -w 60000 > "C:\aaTemp\pingtest.txt" This causes a request times out error (see my separate email). Regards David -----Original Message----- From: AccessD On Behalf Of Stuart McLachlan Sent: Friday, 9 October 2020 8:56 pm To: Access Developers discussion and problem solving Subject: Re: [AccessD] Transferring Files via FTP Yep, you should not have put the protocol in front of the host name PING sftp.electricityregistry.co.nz not PING sftp://sftp.electricityregistry.co.nz On 9 Oct 2020 at 20:43, David Emerson wrote: > Solved that one by using the IP address instead of the server name. > > -----Original Message----- > From: AccessD On Behalf Of > David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access > Developers discussion and problem solving' > Subject: Re: [AccessD] Transferring > Files via FTP > > Hi Stuart (and others), > > I am working on your code below. I am initially checking that I can > ping to the server using the InternetOK() function but I am getting an > error: Ping request could not find host > sftp://sftp.electricityregistry.co.nz. Please check the name and try > again. > > Here is my modified Code (without error coding): > > Function InternetOK() As Boolean > > Dim strTemp As String, strExe As String, ff As Long > > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > > """ > & TempDir() & "pingtest.txt""" > ShellWait strExe, vbHide > > Debug.Print strExe > ff = FreeFile > Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp > Close #ff > If InStr(strTemp, "Ping request could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > I am able to connect using FileZilla. But this includes a login and > password. > > Can anyone suggest what I am doing wrong? > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand > > > > -----Original Message----- > From: AccessD On Behalf Of > Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access > Developers discussion and problem solving > Subject: Re: [AccessD] Transferring > Files via FTP > > Heres' a modFTP from an old application of mine which uses the built > in Windows FTP client and an FTP script generated "on the fly". It > will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. > > (These days, I SHELL to my own applicationa written in PowerBASIC for > all FPT processes) > > > Option Explicit > Option Compare Database > > Private Const STARTF_USESHOWWINDOW& = &H1 Private Const > NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& > > Public g_strFTPPutList() As String > > Private Type STARTUPINFO > cb As Long > lpReserved As String > lpDesktop As String > lpTitle As String > dwX As Long > dwY As Long > dwXSize As Long > dwYSize As Long > dwXCountChars As Long > dwYCountChars As Long > dwFillAttribute As Long > dwFlags As Long > wShowWindow As Integer > cbReserved2 As Integer > lpReserved2 As Long > hStdInput As Long > hStdOutput As Long > hStdError As Long > End Type > > Private Type PROCESS_INFORMATION > hProcess As Long > hThread As Long > dwProcessID As Long > dwThreadID As Long > End Type > > Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As > Long, ByVal dwMilliseconds As Long) As Long > > Declare Function CreateProcessA Lib "kernel32" (ByVal > lpApplicationName As Long, ByVal lpCommandLine As String, ByVal > lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal > bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal > lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo > As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long > > Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As > Long > > Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) > On Error GoTo Err_Handler > > Dim proc As PROCESS_INFORMATION > Dim start As STARTUPINFO > Dim ret As Long > > ' Initialize the STARTUPINFO structure: > With start > .cb = Len(start) > If Not IsMissing(WindowStyle) Then > .dwFlags = STARTF_USESHOWWINDOW > .wShowWindow = WindowStyle > End If > End With > ' Start the shelled application: > ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, > NORMAL_PRIORITY_CLASS, > 0&, 0&, start, proc) > ' Wait for the shelled application to finish: > ret& = WaitForSingleObject(proc.hProcess, INFINITE) > ret& = CloseHandle(proc.hProcess) > > Exit_Here: > Exit Sub > Err_Handler: > MsgBox Err.Description, vbExclamation, "E R R O R" > Resume Exit_Here > > End Sub > > > 'Following functions look for Site, Login, PW in table usysWeb > Function ListFTPFiles(Directory As String) As Variant Const q As > String * 1 = """" Dim sEXE As String Dim strList As String Dim > strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() > & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print > #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print > #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, > Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList > & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & > "webfiles.txt" For Input As #ff While Not EOF(ff) > x = x + 1 > ReDim Preserve strFIles(x) > Line Input #1, strFIles(x) > Wend > Close #ff > 'Kill TempDir() & "webfiles.txt" > ListFTPFiles = strFIles() > End Function > > Function FTPPut(Directory As String, Filename As String) As Boolean > Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As > String Dim strFName As String Dim strList As String Dim ff As Long If > Dir(Filename) = "" Then > MsgBox Filename & " not found!" > Exit Function > End If > strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If > Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" > strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print > #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End > Function > > Function FTPGet(Filename As String, LocalDirectory As String) As > Boolean Const q As String * 1 = """" Dim strExe As String Dim > strFTPDir As String Dim strFName As String Dim strList As String Dim > ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then > MsgBox LocalDirectory & " not found" > Exit Function > End If > strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = > Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & > "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, > "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print > #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = > Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - > Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q > ShellWait strExe, vbHide Kill strList End Function > > Function InternetOK() As Boolean > Dim strTemp As String > Dim strExe As String > Dim ff As Long > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ > & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print > strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request > could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > Function FTPPutList(FileList() As String) As Boolean 'FileList Array > is 0 based Row(0) is blank. ' Subsequent rows formatted as: > RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" > Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As > String Dim strLocalDirStore As String Dim strRemoteDirStore As String > Dim strFileName As String Dim strList As String Dim strCmds As String > Dim ff As Long Dim x As Long Dim strPut() As String strCmds = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "binary" > > For x = 1 To UBound(FileList()) > strPut() = Split(FileList(x), Chr$(9)) > strRemoteDir = strPut(0) > strLocalDir = strPut(1) > strFileName = strPut(2) > > If strRemoteDir <> strRemoteDirStore Then > Print #ff, "cd " & strRemoteDir > strRemoteDirStore = strRemoteDir > End If > > If strLocalDir <> strLocalDirStore Then > Print #ff, "lcd " & strLocalDir > strLocalDirStore = strLocalDir > End If > > If Dir(strLocalDir & strFileName) = "" Then > MsgBox strLocalDir & strFileName & " not found!" > Exit Function > End If > > Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function > ---------------------- END OF modFTP > > modFTP also uses this > > Private Declare Function GetTempPath Lib "kernel32" Alias > "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As > String) As Long > > Public Function TempDir() As String > Dim strPath As String > strPath = Space(MAX_PATH) > GetTempPath Len(strPath), strPath > TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End > Function > > > > On 6 May 2020 at 11:07, David Emerson wrote: > > > Hi Listers, > > > > > > > > I hope everyone is keeping safe. > > > > > > > > Can anyone give me recommendations for code/software so that I can > > log into a secure FTP site using a username and password, and upload > > and download files via vba? > > > > > > > > Regards > > > > David Emerson > > Dalyn Software Ltd > > Wellington, New Zealand > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From gustav at cactus.dk Fri Oct 9 03:18:55 2020 From: gustav at cactus.dk (Gustav Brock) Date: Fri, 9 Oct 2020 08:18:55 +0000 Subject: [AccessD] Transferring Files via FTP Message-ID: Hi David > I am able to connect using FileZilla. But this includes a login and password. I guess you still need to pass your credentials. /gustav From newsgrps at dalyn.co.nz Fri Oct 9 03:31:50 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 21:31:50 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: References: Message-ID: <003c01d69e16$a4615680$ed240380$@dalyn.co.nz> I can't find any ping commands that accept the credentials. I get the same problem when I try getting a list of files using this function: Function ListFTPFiles(strFTPLogin As String, strFTPPassword As String, strDirectory As String) As Variant On Error GoTo Err_ListFTPFiles Const q As String * 1 = """" Dim sEXE As String, strList As String, strFiles() As String, x As Long, ff As Long strList = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, "open " & Nz(basCustomDLookUp("FTPSiteAddress", "dbo.tlkpSystemSetting", "SYID = 1"), "") Print #ff, strFTPLogin Print #ff, strFTPPassword Print #ff, "cd " & strDirectory Print #ff, "ls . " & TempDir() & "webfiles.txt" Print #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList & q ShellWait sEXE, vbHide ' Kill strList ff = FreeFile Open TempDir() & "webfiles.txt" For Input As #ff While Not EOF(ff) x = x + 1 ReDim Preserve strFiles(x) Line Input #1, strFiles(x) Wend Close #ff 'Kill TempDir() & "webfiles.txt" ListFTPFiles = strFiles() The webfiles.txt file is not being created. The strDirectory ("EIEPin ") exists and is off the root directory. It also has files in it. Do I need to send the port number through? It should be 22. David -----Original Message----- From: AccessD On Behalf Of Gustav Brock via AccessD Sent: Friday, 9 October 2020 9:19 pm To: Access Developers discussion and problem solving Cc: Gustav Brock Subject: Re: [AccessD] Transferring Files via FTP Hi David > I am able to connect using FileZilla. But this includes a login and password. I guess you still need to pass your credentials. /gustav -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From stuart at lexacorp.com.pg Fri Oct 9 04:09:10 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 09 Oct 2020 19:09:10 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <003801d69e13$57938060$06ba8120$@dalyn.co.nz> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz>, <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz>, <003801d69e13$57938060$06ba8120$@dalyn.co.nz> Message-ID: <5F8028B6.23613.B4D961@stuart.lexacorp.com.pg> They are blocking PINGs so a PING test won't work for that site. However I was able to connect to that host using SFTP through WInSCP. on Port 22 On 9 Oct 2020 at 21:08, David Emerson wrote: > Spoke too soon. Now the Ping message is: > > Pinging 143.96.3.34 with 32 bytes of data: > Request timed out. > > Ping statistics for 143.96.3.34: > Packets: Sent = 1, Received = 0, Lost = 1 (100% loss), > > I have increased the wait time to 60 seconds but still with the same > result. > > > Here is the ping command: > C:\Windows\system32\cmd.exe /c ping 143.96.3.34 -n 1 -w 60000 > > "C:\aaTemp\pingtest.txt" > > However, I cannot connect with FileZilla using the IP Address. It > only seems to work with sftp://sftp.electricityregistry.co.nz (and > connects within a couple of seconds). > > In summary, > Pinging the server name gets: Ping request could not find host > sftp://sftp.electricityregistry.co.nz. > Pinging the server IP gets: Request timed out. > Connecting via FileZilla using the server name (and login) works. > > What is my code missing? > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand > > > > -----Original Message----- > From: AccessD On Behalf Of > David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access > Developers discussion and problem solving' > Subject: Re: [AccessD] Transferring > Files via FTP > > Hi Stuart (and others), > > I am working on your code below. I am initially checking that I can > ping to the server using the InternetOK() function but I am getting an > error: Ping request could not find host > sftp://sftp.electricityregistry.co.nz. Please check the name and try > again. > > Here is my modified Code (without error coding): > > Function InternetOK() As Boolean > > Dim strTemp As String, strExe As String, ff As Long > > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > > """ > & TempDir() & "pingtest.txt""" > ShellWait strExe, vbHide > > Debug.Print strExe > ff = FreeFile > Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp > Close #ff > If InStr(strTemp, "Ping request could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > I am able to connect using FileZilla. But this includes a login and > password. > > Can anyone suggest what I am doing wrong? > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand > > > > -----Original Message----- > From: AccessD On Behalf Of > Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access > Developers discussion and problem solving > Subject: Re: [AccessD] Transferring > Files via FTP > > Heres' a modFTP from an old application of mine which uses the built > in Windows FTP client and an FTP script generated "on the fly". It > will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. > > (These days, I SHELL to my own applicationa written in PowerBASIC > for all FPT processes) > > > Option Explicit > Option Compare Database > > Private Const STARTF_USESHOWWINDOW& = &H1 Private Const > NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& > > Public g_strFTPPutList() As String > > Private Type STARTUPINFO > cb As Long > lpReserved As String > lpDesktop As String > lpTitle As String > dwX As Long > dwY As Long > dwXSize As Long > dwYSize As Long > dwXCountChars As Long > dwYCountChars As Long > dwFillAttribute As Long > dwFlags As Long > wShowWindow As Integer > cbReserved2 As Integer > lpReserved2 As Long > hStdInput As Long > hStdOutput As Long > hStdError As Long > End Type > > Private Type PROCESS_INFORMATION > hProcess As Long > hThread As Long > dwProcessID As Long > dwThreadID As Long > End Type > > Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As > Long, ByVal dwMilliseconds As Long) As Long > > Declare Function CreateProcessA Lib "kernel32" (ByVal > lpApplicationName As Long, ByVal lpCommandLine As String, ByVal > lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal > bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal > lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo > As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long > > Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As > Long > > Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) > On Error GoTo Err_Handler > > Dim proc As PROCESS_INFORMATION > Dim start As STARTUPINFO > Dim ret As Long > > ' Initialize the STARTUPINFO structure: > With start > .cb = Len(start) > If Not IsMissing(WindowStyle) Then > .dwFlags = STARTF_USESHOWWINDOW > .wShowWindow = WindowStyle > End If > End With > ' Start the shelled application: > ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, > NORMAL_PRIORITY_CLASS, > 0&, 0&, start, proc) > ' Wait for the shelled application to finish: > ret& = WaitForSingleObject(proc.hProcess, INFINITE) > ret& = CloseHandle(proc.hProcess) > > Exit_Here: > Exit Sub > Err_Handler: > MsgBox Err.Description, vbExclamation, "E R R O R" > Resume Exit_Here > > End Sub > > > 'Following functions look for Site, Login, PW in table usysWeb > Function ListFTPFiles(Directory As String) As Variant Const q As > String * 1 = """" Dim sEXE As String Dim strList As String Dim > strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() > & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print > #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print > #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, > Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList > & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & > "webfiles.txt" For Input As #ff While Not EOF(ff) > x = x + 1 > ReDim Preserve strFIles(x) > Line Input #1, strFIles(x) > Wend > Close #ff > 'Kill TempDir() & "webfiles.txt" > ListFTPFiles = strFIles() > End Function > > Function FTPPut(Directory As String, Filename As String) As Boolean > Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As > String Dim strFName As String Dim strList As String Dim ff As Long If > Dir(Filename) = "" Then > MsgBox Filename & " not found!" > Exit Function > End If > strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If > Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" > strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print > #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End > Function > > Function FTPGet(Filename As String, LocalDirectory As String) As > Boolean Const q As String * 1 = """" Dim strExe As String Dim > strFTPDir As String Dim strFName As String Dim strList As String Dim > ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then > MsgBox LocalDirectory & " not found" > Exit Function > End If > strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = > Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & > "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, > "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print > #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = > Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - > Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q > ShellWait strExe, vbHide Kill strList End Function > > Function InternetOK() As Boolean > Dim strTemp As String > Dim strExe As String > Dim ff As Long > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ > & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print > strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request > could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > Function FTPPutList(FileList() As String) As Boolean 'FileList Array > is 0 based Row(0) is blank. ' Subsequent rows formatted as: > RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" > Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As > String Dim strLocalDirStore As String Dim strRemoteDirStore As String > Dim strFileName As String Dim strList As String Dim strCmds As String > Dim ff As Long Dim x As Long Dim strPut() As String strCmds = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "binary" > > For x = 1 To UBound(FileList()) > strPut() = Split(FileList(x), Chr$(9)) > strRemoteDir = strPut(0) > strLocalDir = strPut(1) > strFileName = strPut(2) > > If strRemoteDir <> strRemoteDirStore Then > Print #ff, "cd " & strRemoteDir > strRemoteDirStore = strRemoteDir > End If > > If strLocalDir <> strLocalDirStore Then > Print #ff, "lcd " & strLocalDir > strLocalDirStore = strLocalDir > End If > > If Dir(strLocalDir & strFileName) = "" Then > MsgBox strLocalDir & strFileName & " not found!" > Exit Function > End If > > Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function > ---------------------- END OF modFTP > > modFTP also uses this > > Private Declare Function GetTempPath Lib "kernel32" Alias > "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As > String) As Long > > Public Function TempDir() As String > Dim strPath As String > strPath = Space(MAX_PATH) > GetTempPath Len(strPath), strPath > TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End > Function > > > > On 6 May 2020 at 11:07, David Emerson wrote: > > > Hi Listers, > > > > > > > > I hope everyone is keeping safe. > > > > > > > > Can anyone give me recommendations for code/software so that I can > > log into a secure FTP site using a username and password, and > > upload and download files via vba? > > > > > > > > Regards > > > > David Emerson > > Dalyn Software Ltd > > Wellington, New Zealand > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From newsgrps at dalyn.co.nz Fri Oct 9 04:15:19 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 22:15:19 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <5F8028B6.23613.B4D961@stuart.lexacorp.com.pg> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz>, <003601d69e0e$8ee7e060$acb7a120$@dalyn.co.nz>, <003801d69e13$57938060$06ba8120$@dalyn.co.nz> <5F8028B6.23613.B4D961@stuart.lexacorp.com.pg> Message-ID: <000001d69e1c$b7e8f9a0$27baece0$@dalyn.co.nz> So I should ignore the ping test and work on why the ListFTPFiles function is not returning any files? -----Original Message----- From: AccessD On Behalf Of Stuart McLachlan Sent: Friday, 9 October 2020 10:09 pm To: Access Developers discussion and problem solving Subject: Re: [AccessD] Transferring Files via FTP They are blocking PINGs so a PING test won't work for that site. However I was able to connect to that host using SFTP through WInSCP. on Port 22 On 9 Oct 2020 at 21:08, David Emerson wrote: > Spoke too soon. Now the Ping message is: > > Pinging 143.96.3.34 with 32 bytes of data: > Request timed out. > > Ping statistics for 143.96.3.34: > Packets: Sent = 1, Received = 0, Lost = 1 (100% loss), > > I have increased the wait time to 60 seconds but still with the same > result. > > > Here is the ping command: > C:\Windows\system32\cmd.exe /c ping 143.96.3.34 -n 1 -w 60000 > > "C:\aaTemp\pingtest.txt" > > However, I cannot connect with FileZilla using the IP Address. It > only seems to work with sftp://sftp.electricityregistry.co.nz (and > connects within a couple of seconds). > > In summary, > Pinging the server name gets: Ping request could not find host > sftp://sftp.electricityregistry.co.nz. > Pinging the server IP gets: Request timed out. > Connecting via FileZilla using the server name (and login) works. > > What is my code missing? > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand > > > > -----Original Message----- > From: AccessD On Behalf Of > David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access > Developers discussion and problem solving' > Subject: Re: [AccessD] Transferring > Files via FTP > > Hi Stuart (and others), > > I am working on your code below. I am initially checking that I can > ping to the server using the InternetOK() function but I am getting an > error: Ping request could not find host > sftp://sftp.electricityregistry.co.nz. Please check the name and try > again. > > Here is my modified Code (without error coding): > > Function InternetOK() As Boolean > > Dim strTemp As String, strExe As String, ff As Long > > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n 1 > > """ > & TempDir() & "pingtest.txt""" > ShellWait strExe, vbHide > > Debug.Print strExe > ff = FreeFile > Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp > Close #ff > If InStr(strTemp, "Ping request could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > I am able to connect using FileZilla. But this includes a login and > password. > > Can anyone suggest what I am doing wrong? > > Regards > > David Emerson > Dalyn Software Ltd > Wellington, New Zealand > > > > -----Original Message----- > From: AccessD On Behalf Of > Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access > Developers discussion and problem solving > Subject: Re: [AccessD] Transferring > Files via FTP > > Heres' a modFTP from an old application of mine which uses the built > in Windows FTP client and an FTP script generated "on the fly". It > will need PTRSAFE, LONGPTR etc modifications for Officer 64bit. > > (These days, I SHELL to my own applicationa written in PowerBASIC for > all FPT processes) > > > Option Explicit > Option Compare Database > > Private Const STARTF_USESHOWWINDOW& = &H1 Private Const > NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& > > Public g_strFTPPutList() As String > > Private Type STARTUPINFO > cb As Long > lpReserved As String > lpDesktop As String > lpTitle As String > dwX As Long > dwY As Long > dwXSize As Long > dwYSize As Long > dwXCountChars As Long > dwYCountChars As Long > dwFillAttribute As Long > dwFlags As Long > wShowWindow As Integer > cbReserved2 As Integer > lpReserved2 As Long > hStdInput As Long > hStdOutput As Long > hStdError As Long > End Type > > Private Type PROCESS_INFORMATION > hProcess As Long > hThread As Long > dwProcessID As Long > dwThreadID As Long > End Type > > Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As > Long, ByVal dwMilliseconds As Long) As Long > > Declare Function CreateProcessA Lib "kernel32" (ByVal > lpApplicationName As Long, ByVal lpCommandLine As String, ByVal > lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal > bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal > lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo > As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long > > Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As > Long > > Public Sub ShellWait(Pathname As String, Optional WindowStyle As Long) > On Error GoTo Err_Handler > > Dim proc As PROCESS_INFORMATION > Dim start As STARTUPINFO > Dim ret As Long > > ' Initialize the STARTUPINFO structure: > With start > .cb = Len(start) > If Not IsMissing(WindowStyle) Then > .dwFlags = STARTF_USESHOWWINDOW > .wShowWindow = WindowStyle > End If > End With > ' Start the shelled application: > ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, > NORMAL_PRIORITY_CLASS, > 0&, 0&, start, proc) > ' Wait for the shelled application to finish: > ret& = WaitForSingleObject(proc.hProcess, INFINITE) > ret& = CloseHandle(proc.hProcess) > > Exit_Here: > Exit Sub > Err_Handler: > MsgBox Err.Description, vbExclamation, "E R R O R" > Resume Exit_Here > > End Sub > > > 'Following functions look for Site, Login, PW in table usysWeb > Function ListFTPFiles(Directory As String) As Variant Const q As > String * 1 = """" Dim sEXE As String Dim strList As String Dim > strFIles() As String Dim x As Long Dim ff As Long strList = TempDir() > & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print > #ff, "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" Print > #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, > Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & strList > & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open TempDir() & > "webfiles.txt" For Input As #ff While Not EOF(ff) > x = x + 1 > ReDim Preserve strFIles(x) > Line Input #1, strFIles(x) > Wend > Close #ff > 'Kill TempDir() & "webfiles.txt" > ListFTPFiles = strFIles() > End Function > > Function FTPPut(Directory As String, Filename As String) As Boolean > Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As > String Dim strFName As String Dim strList As String Dim ff As Long If > Dir(Filename) = "" Then > MsgBox Filename & " not found!" > Exit Function > End If > strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If > Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" > strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print > #ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList End > Function > > Function FTPGet(Filename As String, LocalDirectory As String) As > Boolean Const q As String * 1 = """" Dim strExe As String Dim > strFTPDir As String Dim strFName As String Dim strList As String Dim > ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then > MsgBox LocalDirectory & " not found" > Exit Function > End If > strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = > Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & > "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print #ff, > "open " & DLookup("Site", "usysWEB") Print #ff, DLookup("Login", > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > strFTPDir Print #ff, "lcd " & LocalDirectory Print #ff, "binary" Print > #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = > Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - > Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q > ShellWait strExe, vbHide Kill strList End Function > > Function InternetOK() As Boolean > Dim strTemp As String > Dim strExe As String > Dim ff As Long > strExe = Environ$("COMSPEC") > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > strExe = Environ("COMSPEC") & " /c " > strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > """ > & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide 'Debug.Print > strExe ff = FreeFile Open TempDir() & "pingtest.txt" For Input As #ff > Line Input #ff, strTemp Close #ff If InStr(strTemp, "Ping request > could not find host") > 0 Then > InternetOK = False > Else > InternetOK = True > End If > > End Function > > Function FTPPutList(FileList() As String) As Boolean 'FileList Array > is 0 based Row(0) is blank. ' Subsequent rows formatted as: > RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = """" > Dim strExe As String Dim strLocalDir As String Dim strRemoteDir As > String Dim strLocalDirStore As String Dim strRemoteDirStore As String > Dim strFileName As String Dim strList As String Dim strCmds As String > Dim ff As Long Dim x As Long Dim strPut() As String strCmds = > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For Output As #ff > Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print > #ff, "binary" > > For x = 1 To UBound(FileList()) > strPut() = Split(FileList(x), Chr$(9)) > strRemoteDir = strPut(0) > strLocalDir = strPut(1) > strFileName = strPut(2) > > If strRemoteDir <> strRemoteDirStore Then > Print #ff, "cd " & strRemoteDir > strRemoteDirStore = strRemoteDir > End If > > If strLocalDir <> strLocalDirStore Then > Print #ff, "lcd " & strLocalDir > strLocalDirStore = strLocalDir > End If > > If Dir(strLocalDir & strFileName) = "" Then > MsgBox strLocalDir & strFileName & " not found!" > Exit Function > End If > > Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & > strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function > ---------------------- END OF modFTP > > modFTP also uses this > > Private Declare Function GetTempPath Lib "kernel32" Alias > "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As > String) As Long > > Public Function TempDir() As String > Dim strPath As String > strPath = Space(MAX_PATH) > GetTempPath Len(strPath), strPath > TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End > Function > > > > On 6 May 2020 at 11:07, David Emerson wrote: > > > Hi Listers, > > > > > > > > I hope everyone is keeping safe. > > > > > > > > Can anyone give me recommendations for code/software so that I can > > log into a secure FTP site using a username and password, and upload > > and download files via vba? > > > > > > > > Regards > > > > David Emerson > > Dalyn Software Ltd > > Wellington, New Zealand > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From stuart at lexacorp.com.pg Fri Oct 9 04:25:25 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 09 Oct 2020 19:25:25 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <003c01d69e16$a4615680$ed240380$@dalyn.co.nz> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz> Message-ID: <5F802C85.6863.CD558@stuart.lexacorp.com.pg> PING is not a protocol that uses authentication. But wgat's worse, Windows FTP.exe doesn't work wth SFTP. On 9 Oct 2020 at 21:31, David Emerson wrote: > I can't find any ping commands that accept the credentials. > > I get the same problem when I try getting a list of files using this > function: > > Function ListFTPFiles(strFTPLogin As String, strFTPPassword As String, > strDirectory As String) As Variant > > On Error GoTo Err_ListFTPFiles > > Const q As String * 1 = """" > > Dim sEXE As String, strList As String, strFiles() As String, x As > Long, > ff As Long > > strList = TempDir() & "FTPCmds.tmp" > ff = FreeFile > > Open strList For Output As #ff > Print #ff, "open " & Nz(basCustomDLookUp("FTPSiteAddress", > "dbo.tlkpSystemSetting", "SYID = 1"), "") > Print #ff, strFTPLogin > Print #ff, strFTPPassword > Print #ff, "cd " & strDirectory > Print #ff, "ls . " & TempDir() & "webfiles.txt" > Print #ff, "bye" > Close #ff > > sEXE = Environ$("COMSPEC") > sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) > sEXE = sEXE & "ftp.exe -s:" & q & strList & q > ShellWait sEXE, vbHide > ' Kill strList > ff = FreeFile > Open TempDir() & "webfiles.txt" For Input As #ff > While Not EOF(ff) > x = x + 1 > ReDim Preserve strFiles(x) > Line Input #1, strFiles(x) > Wend > Close #ff > 'Kill TempDir() & "webfiles.txt" > ListFTPFiles = strFiles() > > The webfiles.txt file is not being created. The strDirectory ("EIEPin > ") exists and is off the root directory. It also has files in it. > > Do I need to send the port number through? It should be 22. > > David > > -----Original Message----- > From: AccessD On Behalf Of > Gustav Brock via AccessD Sent: Friday, 9 October 2020 9:19 pm To: > Access Developers discussion and problem solving > Cc: Gustav Brock > Subject: Re: [AccessD] Transferring Files via FTP > > Hi David > > > I am able to connect using FileZilla. But this includes a login and > password. > > I guess you still need to pass your credentials. > > /gustav > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From stuart at lexacorp.com.pg Fri Oct 9 04:32:01 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 09 Oct 2020 19:32:01 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <000001d69e1c$b7e8f9a0$27baece0$@dalyn.co.nz> References: <001b01d62332$03c66940$0b533bc0$@dalyn.co.nz>, <5F8028B6.23613.B4D961@stuart.lexacorp.com.pg>, <000001d69e1c$b7e8f9a0$27baece0$@dalyn.co.nz> Message-ID: <5F802E11.6287.12E291@stuart.lexacorp.com.pg> It's not returning any files because FTP.exe uses plain text FTP protocol over port 21 SFTP uses a secure (SSH) connection over Port 22. On 9 Oct 2020 at 22:15, David Emerson wrote: > So I should ignore the ping test and work on why the ListFTPFiles > function is not returning any files? > > -----Original Message----- > From: AccessD On Behalf Of > Stuart McLachlan Sent: Friday, 9 October 2020 10:09 pm To: Access > Developers discussion and problem solving > Subject: Re: [AccessD] Transferring > Files via FTP > > They are blocking PINGs so a PING test won't work for that site. > > However I was able to connect to that host using SFTP through WInSCP. > on Port 22 > > On 9 Oct 2020 at 21:08, David Emerson wrote: > > > Spoke too soon. Now the Ping message is: > > > > Pinging 143.96.3.34 with 32 bytes of data: > > Request timed out. > > > > Ping statistics for 143.96.3.34: > > Packets: Sent = 1, Received = 0, Lost = 1 (100% loss), > > > > I have increased the wait time to 60 seconds but still with the same > > result. > > > > > > Here is the ping command: > > C:\Windows\system32\cmd.exe /c ping 143.96.3.34 -n 1 -w 60000 > > > "C:\aaTemp\pingtest.txt" > > > > However, I cannot connect with FileZilla using the IP Address. It > > only seems to work with sftp://sftp.electricityregistry.co.nz (and > > connects within a couple of seconds). > > > > In summary, > > Pinging the server name gets: Ping request could not find host > > sftp://sftp.electricityregistry.co.nz. Pinging the server IP gets: > > Request timed out. Connecting via FileZilla using the server name > > (and login) works. > > > > What is my code missing? > > > > Regards > > > > David Emerson > > Dalyn Software Ltd > > Wellington, New Zealand > > > > > > > > -----Original Message----- > > From: AccessD On Behalf Of > > David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access > > Developers discussion and problem solving' > > Subject: Re: [AccessD] Transferring > > Files via FTP > > > > Hi Stuart (and others), > > > > I am working on your code below. I am initially checking that I can > > ping to the server using the InternetOK() function but I am getting > > an error: Ping request could not find host > > sftp://sftp.electricityregistry.co.nz. Please check the name and try > > again. > > > > Here is my modified Code (without error coding): > > > > Function InternetOK() As Boolean > > > > Dim strTemp As String, strExe As String, ff As Long > > > > strExe = Environ$("COMSPEC") > > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > > > strExe = Environ("COMSPEC") & " /c " > > strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n > > 1 > > > """ > > & TempDir() & "pingtest.txt""" > > ShellWait strExe, vbHide > > > > Debug.Print strExe > > ff = FreeFile > > Open TempDir() & "pingtest.txt" For Input As #ff > > Line Input #ff, strTemp > > Close #ff > > If InStr(strTemp, "Ping request could not find host") > 0 Then > > InternetOK = False > > Else > > InternetOK = True > > End If > > > > End Function > > > > I am able to connect using FileZilla. But this includes a login and > > password. > > > > Can anyone suggest what I am doing wrong? > > > > Regards > > > > David Emerson > > Dalyn Software Ltd > > Wellington, New Zealand > > > > > > > > -----Original Message----- > > From: AccessD On Behalf Of > > Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access > > Developers discussion and problem solving > > Subject: Re: [AccessD] Transferring > > Files via FTP > > > > Heres' a modFTP from an old application of mine which uses the > > built in Windows FTP client and an FTP script generated "on the > > fly". It will need PTRSAFE, LONGPTR etc modifications for Officer > > 64bit. > > > > (These days, I SHELL to my own applicationa written in PowerBASIC > > for all FPT processes) > > > > > > Option Explicit > > Option Compare Database > > > > Private Const STARTF_USESHOWWINDOW& = &H1 Private Const > > NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1& > > > > Public g_strFTPPutList() As String > > > > Private Type STARTUPINFO > > cb As Long > > lpReserved As String > > lpDesktop As String > > lpTitle As String > > dwX As Long > > dwY As Long > > dwXSize As Long > > dwYSize As Long > > dwXCountChars As Long > > dwYCountChars As Long > > dwFillAttribute As Long > > dwFlags As Long > > wShowWindow As Integer > > cbReserved2 As Integer > > lpReserved2 As Long > > hStdInput As Long > > hStdOutput As Long > > hStdError As Long > > End Type > > > > Private Type PROCESS_INFORMATION > > hProcess As Long > > hThread As Long > > dwProcessID As Long > > dwThreadID As Long > > End Type > > > > Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle > > As Long, ByVal dwMilliseconds As Long) As Long > > > > Declare Function CreateProcessA Lib "kernel32" (ByVal > > lpApplicationName As Long, ByVal lpCommandLine As String, ByVal > > lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal > > bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal > > lpEnvironment As Long, ByVal lpCurrentDirectory As Long, > > lpStartupInfo As STARTUPINFO, lpProcessInformation As > > PROCESS_INFORMATION) As Long > > > > Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) > > As Long > > > > Public Sub ShellWait(Pathname As String, Optional WindowStyle As > > Long) On Error GoTo Err_Handler > > > > Dim proc As PROCESS_INFORMATION > > Dim start As STARTUPINFO > > Dim ret As Long > > > > ' Initialize the STARTUPINFO structure: > > With start > > .cb = Len(start) > > If Not IsMissing(WindowStyle) Then > > .dwFlags = STARTF_USESHOWWINDOW > > .wShowWindow = WindowStyle > > End If > > End With > > ' Start the shelled application: > > ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&, > > NORMAL_PRIORITY_CLASS, > > 0&, 0&, start, proc) > > ' Wait for the shelled application to finish: > > ret& = WaitForSingleObject(proc.hProcess, INFINITE) > > ret& = CloseHandle(proc.hProcess) > > > > Exit_Here: > > Exit Sub > > Err_Handler: > > MsgBox Err.Description, vbExclamation, "E R R O R" > > Resume Exit_Here > > > > End Sub > > > > > > 'Following functions look for Site, Login, PW in table usysWeb > > Function ListFTPFiles(Directory As String) As Variant Const q As > > String * 1 = """" Dim sEXE As String Dim strList As String Dim > > strFIles() As String Dim x As Long Dim ff As Long strList = > > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As > > #ff Print > > #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > > #DLookup("Login", > > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " & > > Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt" > > Print > > #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE, > > Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q & > > strList & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open > > TempDir() & "webfiles.txt" For Input As #ff While Not EOF(ff) > > x = x + 1 > > ReDim Preserve strFIles(x) > > Line Input #1, strFIles(x) > > Wend > > Close #ff > > 'Kill TempDir() & "webfiles.txt" > > ListFTPFiles = strFIles() > > End Function > > > > Function FTPPut(Directory As String, Filename As String) As Boolean > > Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As > > String Dim strFName As String Dim strList As String Dim ff As Long > > If Dir(Filename) = "" Then > > MsgBox Filename & " not found!" > > Exit Function > > End If > > strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If > > Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\" > > strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList = > > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As > > #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") > > Print > > #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print > > # ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye" > > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q > > & strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList > > End Function > > > > Function FTPGet(Filename As String, LocalDirectory As String) As > > Boolean Const q As String * 1 = """" Dim strExe As String Dim > > strFTPDir As String Dim strFName As String Dim strList As String Dim > > ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then > > MsgBox LocalDirectory & " not found" > > Exit Function > > End If > > strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName = > > Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() & > > "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print > > #ff, "open " & DLookup("Site", "usysWEB") Print #ff, > > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") > > Print #ff, "cd " & strFTPDir Print #ff, "lcd " & LocalDirectory > > Print #ff, "binary" Print > > #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe = > > Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) - > > Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q > > ShellWait strExe, vbHide Kill strList End Function > > > > Function InternetOK() As Boolean > > Dim strTemp As String > > Dim strExe As String > > Dim ff As Long > > strExe = Environ$("COMSPEC") > > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe))) > > > > strExe = Environ("COMSPEC") & " /c " > > strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 > > > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide > > 'Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt" > > For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp, > > "Ping request could not find host") > 0 Then > > InternetOK = False > > Else > > InternetOK = True > > End If > > > > End Function > > > > Function FTPPutList(FileList() As String) As Boolean 'FileList Array > > is 0 based Row(0) is blank. ' Subsequent rows formatted as: > > RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 = > > """" Dim strExe As String Dim strLocalDir As String Dim strRemoteDir > > As String Dim strLocalDirStore As String Dim strRemoteDirStore As > > String Dim strFileName As String Dim strList As String Dim strCmds > > As String Dim ff As Long Dim x As Long Dim strPut() As String > > strCmds = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For > > Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print > > #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB") > > Print > > #ff, "binary" > > > > For x = 1 To UBound(FileList()) > > strPut() = Split(FileList(x), Chr$(9)) > > strRemoteDir = strPut(0) > > strLocalDir = strPut(1) > > strFileName = strPut(2) > > > > If strRemoteDir <> strRemoteDirStore Then > > Print #ff, "cd " & strRemoteDir > > strRemoteDirStore = strRemoteDir > > End If > > > > If strLocalDir <> strLocalDirStore Then > > Print #ff, "lcd " & strLocalDir > > strLocalDirStore = strLocalDir > > End If > > > > If Dir(strLocalDir & strFileName) = "" Then > > MsgBox strLocalDir & strFileName & " not found!" > > Exit Function > > End If > > > > Print #ff, "put " & q & strFileName & q Next Print #ff, "bye" > > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe, > > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q > > & strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function > > ---------------------- END OF modFTP > > > > modFTP also uses this > > > > Private Declare Function GetTempPath Lib "kernel32" Alias > > "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As > > String) As Long > > > > Public Function TempDir() As String > > Dim strPath As String > > strPath = Space(MAX_PATH) > > GetTempPath Len(strPath), strPath > > TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End > > Function > > > > > > > > On 6 May 2020 at 11:07, David Emerson wrote: > > > > > Hi Listers, > > > > > > > > > > > > I hope everyone is keeping safe. > > > > > > > > > > > > Can anyone give me recommendations for code/software so that I can > > > log into a secure FTP site using a username and password, and > > > upload and download files via vba? > > > > > > > > > > > > Regards > > > > > > David Emerson > > > Dalyn Software Ltd > > > Wellington, New Zealand > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From newsgrps at dalyn.co.nz Fri Oct 9 04:34:51 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Fri, 9 Oct 2020 22:34:51 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <5F802C85.6863.CD558@stuart.lexacorp.com.pg> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz> <5F802C85.6863.CD558@stuart.lexacorp.com.pg> Message-ID: <000101d69e1f$723a81a0$56af84e0$@dalyn.co.nz> ? Does that mean that your code will not help me? Does anyone know of an alternative programme that can be used with vba? -----Original Message----- From: AccessD On Behalf Of Stuart McLachlan Sent: Friday, 9 October 2020 10:25 pm To: Access Developers discussion and problem solving Subject: Re: [AccessD] Transferring Files via FTP PING is not a protocol that uses authentication. But wgat's worse, Windows FTP.exe doesn't work wth SFTP. On 9 Oct 2020 at 21:31, David Emerson wrote: > I can't find any ping commands that accept the credentials. > > I get the same problem when I try getting a list of files using this > function: > > Function ListFTPFiles(strFTPLogin As String, strFTPPassword As String, > strDirectory As String) As Variant > > On Error GoTo Err_ListFTPFiles > > Const q As String * 1 = """" > > Dim sEXE As String, strList As String, strFiles() As String, x As > Long, > ff As Long > > strList = TempDir() & "FTPCmds.tmp" > ff = FreeFile > > Open strList For Output As #ff > Print #ff, "open " & Nz(basCustomDLookUp("FTPSiteAddress", > "dbo.tlkpSystemSetting", "SYID = 1"), "") > Print #ff, strFTPLogin > Print #ff, strFTPPassword > Print #ff, "cd " & strDirectory > Print #ff, "ls . " & TempDir() & "webfiles.txt" > Print #ff, "bye" > Close #ff > > sEXE = Environ$("COMSPEC") > sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) > sEXE = sEXE & "ftp.exe -s:" & q & strList & q > ShellWait sEXE, vbHide > ' Kill strList > ff = FreeFile > Open TempDir() & "webfiles.txt" For Input As #ff > While Not EOF(ff) > x = x + 1 > ReDim Preserve strFiles(x) > Line Input #1, strFiles(x) > Wend > Close #ff > 'Kill TempDir() & "webfiles.txt" > ListFTPFiles = strFiles() > > The webfiles.txt file is not being created. The strDirectory ("EIEPin > ") exists and is off the root directory. It also has files in it. > > Do I need to send the port number through? It should be 22. > > David > > -----Original Message----- > From: AccessD On Behalf Of > Gustav Brock via AccessD Sent: Friday, 9 October 2020 9:19 pm To: > Access Developers discussion and problem solving > Cc: Gustav Brock > Subject: Re: [AccessD] Transferring Files via FTP > > Hi David > > > I am able to connect using FileZilla. But this includes a login and > password. > > I guess you still need to pass your credentials. > > /gustav > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From stuart at lexacorp.com.pg Fri Oct 9 04:39:58 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Fri, 09 Oct 2020 19:39:58 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <5F802C85.6863.CD558@stuart.lexacorp.com.pg> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> Message-ID: <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> Probaby the easiest solution is to downlad WinSCP and use it in commandline mode with a script simiar to using FTP.exe See https://winscp.net/eng/docs/scripting On 9 Oct 2020 at 19:25, Stuart McLachlan wrote: > PING is not a protocol that uses authentication. > > But wgat's worse, Windows FTP.exe doesn't work wth SFTP. > > > On 9 Oct 2020 at 21:31, David Emerson wrote: > > > I can't find any ping commands that accept the credentials. > > > > I get the same problem when I try getting a list of files using this > > function: > > > > Function ListFTPFiles(strFTPLogin As String, strFTPPassword As > > String, strDirectory As String) As Variant > > > > On Error GoTo Err_ListFTPFiles > > > > Const q As String * 1 = """" > > > > Dim sEXE As String, strList As String, strFiles() As String, x > > As Long, > > ff As Long > > > > strList = TempDir() & "FTPCmds.tmp" > > ff = FreeFile > > > > Open strList For Output As #ff > > Print #ff, "open " & Nz(basCustomDLookUp("FTPSiteAddress", > > "dbo.tlkpSystemSetting", "SYID = 1"), "") > > Print #ff, strFTPLogin > > Print #ff, strFTPPassword > > Print #ff, "cd " & strDirectory > > Print #ff, "ls . " & TempDir() & "webfiles.txt" > > Print #ff, "bye" > > Close #ff > > > > sEXE = Environ$("COMSPEC") > > sEXE = Left$(sEXE, Len(sEXE) - Len(Dir(sEXE))) > > sEXE = sEXE & "ftp.exe -s:" & q & strList & q > > ShellWait sEXE, vbHide > > ' Kill strList > > ff = FreeFile > > Open TempDir() & "webfiles.txt" For Input As #ff > > While Not EOF(ff) > > x = x + 1 > > ReDim Preserve strFiles(x) > > Line Input #1, strFiles(x) > > Wend > > Close #ff > > 'Kill TempDir() & "webfiles.txt" > > ListFTPFiles = strFiles() > > > > The webfiles.txt file is not being created. The strDirectory > > ("EIEPin ") exists and is off the root directory. It also has files > > in it. > > > > Do I need to send the port number through? It should be 22. > > > > David > > > > -----Original Message----- > > From: AccessD On Behalf Of > > Gustav Brock via AccessD Sent: Friday, 9 October 2020 9:19 pm To: > > Access Developers discussion and problem solving > > Cc: Gustav Brock > > Subject: Re: [AccessD] Transferring Files via FTP > > > > Hi David > > > > > I am able to connect using FileZilla. But this includes a login > > > and > > password. > > > > I guess you still need to pass your credentials. > > > > /gustav > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From jimdettman at verizon.net Fri Oct 9 06:51:45 2020 From: jimdettman at verizon.net (Jim Dettman) Date: Fri, 9 Oct 2020 07:51:45 -0400 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> Message-ID: <01dd01d69e32$901d48c0$b057da40$@verizon.net> Few things to add: 1. I've used WinSCP for SFTP, MoveItFreely for FTPs, along with the Microsoft FTP client to cover all the bases. I've pasted in an example of using WinSCP to get a directory listing below. 2. Rather than a ping, which is often blocked by firewalls, you can use TELNET to test manually if a server is reachable. It also allows you to type commands manually one by one to confirm where scripts might be going wrong. 3. When doing the scripts, always put them in a batch file, then call the batch file. This allows you to execute the bat file manually outside of your code. Normally what I do is TELNET first, figuring out the commands I need, then build a batch file and test that, then build the batch file in code and test that. HTH, Jim. Function FTPDirListWinSCP(strFiles As String, strFTPDir As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String) As Boolean ' Returns list of files in a remote directory. ' Note that with the WinSCP client, the only way to capture the ' files in a directory is with the /LOG option in the command line using an XML format for it. ' ' Normally with most clients, writing the output to a file is an option ' of the Dir or ls commands. WinSCP doesn't have this option. ' ' The log file is the regular redirect of the command line output as with the other clients. Const RoutineName = "FTPDirListWinSCP" Const Version = "2.2.1" Dim strFTPCommandFile As String Dim strFTPScriptFile As String Dim strFTPLogfile As String Dim strFileName As String Dim strDestName As String Dim lngHWnd As Long Dim intFileNum As Integer Dim intRet As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDirListWinSCP_Error 20 FTPDirListWinSCP = False ' Generate file names 30 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 40 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 50 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 60 intFileNum = FreeFile 70 Open strFTPScriptFile For Output As #intFileNum 80 Print #intFileNum, "option batch on" 90 Print #intFileNum, "option confirm off" 100 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 110 Print #intFileNum, "ls " & Chr$(34) & strFTPDir & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /log=" & Chr$(34) & strFTPLogfile & Chr$(34) 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) 'Stop ' Check log file (file is returned whether the directory query was good or bad, ' so the command log needs to be checked). 210 If IsValidFTPWinSCPDirectoryCall(strFTPLogfile, strFiles) = True Then 220 FTPDirListWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 Else 270 oOCS_SendMail.SetParams "ITALERT", ".", "." 280 oOCS_SendMail.Subject = "FTP Directory query failed" 290 strMailMessage = "Unable to query directory " & strFTPDir & " on FTP site." & vbCrLf 300 strMailMessage = strMailMessage & "Command, script, and Log files are attached." & vbCrLf & vbCrLf 310 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 320 oOCS_SendMail.Message = strMailMessage 330 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 340 oOCS_SendMail.Send 350 End If 360 End If FTPDirListWinSCP_Exit: 370 On Error Resume Next 380 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 390 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 400 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 410 Close #intFileNum 420 Set oOCS_SendMail = Nothing 430 Exit Function FTPDirListWinSCP_Error: 440 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 450 FTPDirListWinSCP = False 460 Resume FTPDirListWinSCP_Exit End Function Function IsValidFTPWinSCPDirectoryCall(strFTPLogfile As String, strFiles As String) As Boolean ' Checks log file to see if last FTP directory/file operation was OK. ' This is used to check for directory listings. ' Files are picked up in the process of determining if the call was valid or not. ' The command log shows 'result sccess="true" if valid. ' Log file is in XML format Const RoutineName = "IsValidFTPWinSCPDirectoryCall" Const Version = "1.0.0.0" Dim intFileNum As Integer Dim lsLine As String Dim strFileName As String 10 On Error GoTo IsValidFTPWinSCPDirectoryCall_Error 20 IsValidFTPWinSCPDirectoryCall = False 30 strFiles = "" 40 intFileNum = FreeFile 50 Open strFTPLogfile For Input As #intFileNum 60 Do While Not EOF(intFileNum) And IsValidFTPWinSCPDirectoryCall = False 70 Line Input #intFileNum, lsLine ' See if a file is referenced 80 If InStr(1, lsLine, " 0 Then IsValidFTPWinSCPDirectoryCall = True 130 Loop IsValidFTPWinSCPDirectoryCall_Exit: 140 On Error Resume Next 150 Close #intFileNum 160 Exit Function IsValidFTPWinSCPDirectoryCall_Error: 170 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 180 IsValidFTPWinSCPDirectoryCall = False 190 Resume IsValidFTPWinSCPDirectoryCall_Exit End Function From newsgrps at dalyn.co.nz Fri Oct 9 14:27:10 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Sat, 10 Oct 2020 08:27:10 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <01dd01d69e32$901d48c0$b057da40$@verizon.net> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> <01dd01d69e32$901d48c0$b057da40$@verizon.net> Message-ID: <000201d69e72$31333c30$9399b490$@dalyn.co.nz> Jim, Much appreciated. Do you have WinSCP examples for getting files from and putting files up to a SFTP site? Regards David -----Original Message----- From: AccessD On Behalf Of Jim Dettman via AccessD Sent: Saturday, 10 October 2020 12:52 am To: 'Access Developers discussion and problem solving' Cc: Jim Dettman Subject: Re: [AccessD] Transferring Files via FTP Few things to add: 1. I've used WinSCP for SFTP, MoveItFreely for FTPs, along with the Microsoft FTP client to cover all the bases. I've pasted in an example of using WinSCP to get a directory listing below. 2. Rather than a ping, which is often blocked by firewalls, you can use TELNET to test manually if a server is reachable. It also allows you to type commands manually one by one to confirm where scripts might be going wrong. 3. When doing the scripts, always put them in a batch file, then call the batch file. This allows you to execute the bat file manually outside of your code. Normally what I do is TELNET first, figuring out the commands I need, then build a batch file and test that, then build the batch file in code and test that. HTH, Jim. Function FTPDirListWinSCP(strFiles As String, strFTPDir As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String) As Boolean ' Returns list of files in a remote directory. ' Note that with the WinSCP client, the only way to capture the ' files in a directory is with the /LOG option in the command line using an XML format for it. ' ' Normally with most clients, writing the output to a file is an option ' of the Dir or ls commands. WinSCP doesn't have this option. ' ' The log file is the regular redirect of the command line output as with the other clients. Const RoutineName = "FTPDirListWinSCP" Const Version = "2.2.1" Dim strFTPCommandFile As String Dim strFTPScriptFile As String Dim strFTPLogfile As String Dim strFileName As String Dim strDestName As String Dim lngHWnd As Long Dim intFileNum As Integer Dim intRet As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDirListWinSCP_Error 20 FTPDirListWinSCP = False ' Generate file names 30 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 40 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 50 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 60 intFileNum = FreeFile 70 Open strFTPScriptFile For Output As #intFileNum 80 Print #intFileNum, "option batch on" 90 Print #intFileNum, "option confirm off" 100 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 110 Print #intFileNum, "ls " & Chr$(34) & strFTPDir & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /log=" & Chr$(34) & strFTPLogfile & Chr$(34) 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) 'Stop ' Check log file (file is returned whether the directory query was good or bad, ' so the command log needs to be checked). 210 If IsValidFTPWinSCPDirectoryCall(strFTPLogfile, strFiles) = True Then 220 FTPDirListWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 Else 270 oOCS_SendMail.SetParams "ITALERT", ".", "." 280 oOCS_SendMail.Subject = "FTP Directory query failed" 290 strMailMessage = "Unable to query directory " & strFTPDir & " on FTP site." & vbCrLf 300 strMailMessage = strMailMessage & "Command, script, and Log files are attached." & vbCrLf & vbCrLf 310 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 320 oOCS_SendMail.Message = strMailMessage 330 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 340 oOCS_SendMail.Send 350 End If 360 End If FTPDirListWinSCP_Exit: 370 On Error Resume Next 380 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 390 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 400 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 410 Close #intFileNum 420 Set oOCS_SendMail = Nothing 430 Exit Function FTPDirListWinSCP_Error: 440 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 450 FTPDirListWinSCP = False 460 Resume FTPDirListWinSCP_Exit End Function Function IsValidFTPWinSCPDirectoryCall(strFTPLogfile As String, strFiles As String) As Boolean ' Checks log file to see if last FTP directory/file operation was OK. ' This is used to check for directory listings. ' Files are picked up in the process of determining if the call was valid or not. ' The command log shows 'result sccess="true" if valid. ' Log file is in XML format Const RoutineName = "IsValidFTPWinSCPDirectoryCall" Const Version = "1.0.0.0" Dim intFileNum As Integer Dim lsLine As String Dim strFileName As String 10 On Error GoTo IsValidFTPWinSCPDirectoryCall_Error 20 IsValidFTPWinSCPDirectoryCall = False 30 strFiles = "" 40 intFileNum = FreeFile 50 Open strFTPLogfile For Input As #intFileNum 60 Do While Not EOF(intFileNum) And IsValidFTPWinSCPDirectoryCall = False 70 Line Input #intFileNum, lsLine ' See if a file is referenced 80 If InStr(1, lsLine, " 0 Then IsValidFTPWinSCPDirectoryCall = True 130 Loop IsValidFTPWinSCPDirectoryCall_Exit: 140 On Error Resume Next 150 Close #intFileNum 160 Exit Function IsValidFTPWinSCPDirectoryCall_Error: 170 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 180 IsValidFTPWinSCPDirectoryCall = False 190 Resume IsValidFTPWinSCPDirectoryCall_Exit End Function -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From jimdettman at verizon.net Fri Oct 9 15:28:13 2020 From: jimdettman at verizon.net (Jim Dettman) Date: Fri, 9 Oct 2020 16:28:13 -0400 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <000201d69e72$31333c30$9399b490$@dalyn.co.nz> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> <01dd01d69e32$901d48c0$b057da40$@verizon.net> <000201d69e72$31333c30$9399b490$@dalyn.co.nz> Message-ID: <026601d69e7a$b6591b20$230b5160$@verizon.net> David, << Do you have WinSCP examples for getting files from and putting files up to a SFTP site?>> They are below. Some notes: 1. These are single file operations with a login/out for each file, which is highly inefficient if you have a lot of files to transfer. These were specifically written this way due to the nature of the application. Most FTP clients have a MGET() / MPUT() ('M' for many) command available. Not sure what WinSCP has available in that regard. 2. These routines were written over fifteen years ago. The commands available with WinSCP I'm sure have been changed/expanded. This code however does work today and is currently in production. 3. These routines do not employ any type of "guarding" (ensuring a file operation is complete). With FTP, there is no file locking available so it's possible that a file might be worked with (i.e. moved) before the transfer is complete. There are two ways to accomplish that: a. You create a "guard file" first, then delete it when done. i.e. myFile.grd is created, myFile.txt is transferred, and mfFile.grd is deleted. b. You send the file with a modified extension, then rename it when the send is complete. i.e. myFile.xfer becomes myFile.txt when done. Of course both ends must honor whatever method you use. Single file transfers are typically not a problem, unless the files are large. But you will run into this problem if you use any type of MGET()/MPUT() type process. I avoided a lot of problems by taking a directory snapshot first, then working with the files one by one, which is one reason why these routines are written the way they are. 4. Some FTP clients now have a sync command, which keeps a local and remote directory in sync. Might be of interest depending on what your needs are. I believe WinSCP has such a command now. 5. There's stuff in here that you won't have that you'll need to strip out (WaitWhileRunning (), sending of e-mails, and the error handler). Best of luck with the project, Jim. Function IsValidFTPWinSCP(strFTPLogfile As String) As Boolean ' Checks log file to see if last FTP operation OK. Const RoutineName = "IsValidFTPWinSCP" Const Version = "1.3" Dim intFileNum As Integer Dim lsLine As String 10 On Error GoTo IsValidFTPWinSCP_Error 20 IsValidFTPWinSCP = False 30 intFileNum = FreeFile 40 Open strFTPLogfile For Input As #intFileNum 50 Do While Not EOF(intFileNum) And IsValidFTPWinSCP = False 60 Line Input #intFileNum, lsLine 70 If InStr(lsLine, "result success=" & Chr$(34) & "true") > 0 Then IsValidFTPWinSCP = True 80 Loop IsValidFTPWinSCP_Exit: 90 On Error Resume Next 100 Close #intFileNum 110 Exit Function IsValidFTPWinSCP_Error: 120 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 130 Resume IsValidFTPWinSCP_Exit End Function Function FTPUploadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to upload file to FTP site. ' Uses WinSCP Client to upload File, which allows a SFTP transfer. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 2.2.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' Changed logging to XML format. Const RoutineName = "FTPUploadFileWinSCP" Const Version = "2.2.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPUploadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34) & " " & Chr$(34) & strFTPFilename & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPUploadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPUploadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "WinSCP FTP Upload failed." 300 strMailMessage = "The file: " & strLocalFileName & " did not upload." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPUploadFileWinSCP = False 370 End If 380 End If FTPUploadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPUploadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPUploadFileWinSCP = False 470 Resume FTPUploadFileWinSCP_Exit End Function Function FTPDownloadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to download a file from a FTP site. ' Sends e-mail to ITALERT if download fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDownloadFileWinSCP" Const Version = "1.0.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDownloadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "Get " & Chr$(34) & strFTPFilename & Chr$(34) & " " & Chr$(34) & strLocalFileName & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPDownloadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPDownloadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "FTP download failed" 300 strMailMessage = "The file: " & strFTPFilename & " did not download." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPDownloadFileWinSCP = False 370 End If 380 End If FTPDownloadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPDownloadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPDownloadFileWinSCP = False 470 Resume FTPDownloadFileWinSCP_Exit End Function Function FTPDeleteFileWinSCP(strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String) As Boolean ' Procedure to delete file on FTP site. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDeleteFileWinSCP" Const Version = "1.0.1.0" Dim strFTPCommandFile As String Dim strFTPScriptFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDeleteFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "rm " & Chr$(34) & strFTPFilename & Chr$(34) 110 Print #intFileNum, "Close" 120 Print #intFileNum, "Exit" 130 Close #intFileNum ' Write command file 140 intFileNum = FreeFile 150 Open strFTPCommandFile For Output As #intFileNum 160 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 170 Close #intFileNum ' Execute 180 lngHWnd = Shell(strFTPCommandFile, vbHide) 190 WaitWhileRunning (lngHWnd) ' Check log file 200 If IsValidFTPWinSCP(strFTPLogfile) Then 210 FTPDeleteFileWinSCP = True 220 Else 230 If DebugMode() = True Then 240 Stop 250 FTPDeleteFileWinSCP = False 260 Else 270 oOCS_SendMail.SetParams "ITALERT", ".", "." 280 oOCS_SendMail.Subject = "FTP Delete failed" 290 strMailMessage = "The file: " & strFTPFilename & " did not delete from the FTP site." & vbCrLf 300 strMailMessage = strMailMessage & "Command, script, and Log files are attached." & vbCrLf & vbCrLf 310 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 320 oOCS_SendMail.Message = strMailMessage 330 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 340 oOCS_SendMail.Send 350 FTPDeleteFileWinSCP = False 360 End If 370 End If FTPDeleteFileWinSCP_Exit: 380 On Error Resume Next 390 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 400 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 410 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 420 Close #intFileNum 430 Exit Function FTPDeleteFileWinSCP_Error: 440 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 450 Resume FTPDeleteFileWinSCP_Exit End Function From newsgrps at dalyn.co.nz Fri Oct 9 15:49:43 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Sat, 10 Oct 2020 09:49:43 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <026601d69e7a$b6591b20$230b5160$@verizon.net> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> <01dd01d69e32$901d48c0$b057da40$@verizon.net> <000201d69e72$31333c30$9399b490$@dalyn.co.nz> <026601d69e7a$b6591b20$230b5160$@verizon.net> Message-ID: <000b01d69e7d$b92fb360$2b8f1a20$@dalyn.co.nz> Thanks Jim, That will get me a long way along the track. -----Original Message----- From: AccessD On Behalf Of Jim Dettman via AccessD Sent: Saturday, 10 October 2020 9:28 am To: AccessD List Cc: Jim Dettman Subject: Re: [AccessD] Transferring Files via FTP David, << Do you have WinSCP examples for getting files from and putting files up to a SFTP site?>> They are below. Some notes: 1. These are single file operations with a login/out for each file, which is highly inefficient if you have a lot of files to transfer. These were specifically written this way due to the nature of the application. Most FTP clients have a MGET() / MPUT() ('M' for many) command available. Not sure what WinSCP has available in that regard. 2. These routines were written over fifteen years ago. The commands available with WinSCP I'm sure have been changed/expanded. This code however does work today and is currently in production. 3. These routines do not employ any type of "guarding" (ensuring a file operation is complete). With FTP, there is no file locking available so it's possible that a file might be worked with (i.e. moved) before the transfer is complete. There are two ways to accomplish that: a. You create a "guard file" first, then delete it when done. i.e. myFile.grd is created, myFile.txt is transferred, and mfFile.grd is deleted. b. You send the file with a modified extension, then rename it when the send is complete. i.e. myFile.xfer becomes myFile.txt when done. Of course both ends must honor whatever method you use. Single file transfers are typically not a problem, unless the files are large. But you will run into this problem if you use any type of MGET()/MPUT() type process. I avoided a lot of problems by taking a directory snapshot first, then working with the files one by one, which is one reason why these routines are written the way they are. 4. Some FTP clients now have a sync command, which keeps a local and remote directory in sync. Might be of interest depending on what your needs are. I believe WinSCP has such a command now. 5. There's stuff in here that you won't have that you'll need to strip out (WaitWhileRunning (), sending of e-mails, and the error handler). Best of luck with the project, Jim. Function IsValidFTPWinSCP(strFTPLogfile As String) As Boolean ' Checks log file to see if last FTP operation OK. Const RoutineName = "IsValidFTPWinSCP" Const Version = "1.3" Dim intFileNum As Integer Dim lsLine As String 10 On Error GoTo IsValidFTPWinSCP_Error 20 IsValidFTPWinSCP = False 30 intFileNum = FreeFile 40 Open strFTPLogfile For Input As #intFileNum 50 Do While Not EOF(intFileNum) And IsValidFTPWinSCP = False 60 Line Input #intFileNum, lsLine 70 If InStr(lsLine, "result success=" & Chr$(34) & "true") > 0 Then IsValidFTPWinSCP = True 80 Loop IsValidFTPWinSCP_Exit: 90 On Error Resume Next 100 Close #intFileNum 110 Exit Function IsValidFTPWinSCP_Error: 120 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 130 Resume IsValidFTPWinSCP_Exit End Function Function FTPUploadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to upload file to FTP site. ' Uses WinSCP Client to upload File, which allows a SFTP transfer. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 2.2.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' Changed logging to XML format. Const RoutineName = "FTPUploadFileWinSCP" Const Version = "2.2.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPUploadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34) & " " & Chr$(34) & strFTPFilename & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPUploadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPUploadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "WinSCP FTP Upload failed." 300 strMailMessage = "The file: " & strLocalFileName & " did not upload." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPUploadFileWinSCP = False 370 End If 380 End If FTPUploadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPUploadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPUploadFileWinSCP = False 470 Resume FTPUploadFileWinSCP_Exit End Function Function FTPDownloadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to download a file from a FTP site. ' Sends e-mail to ITALERT if download fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDownloadFileWinSCP" Const Version = "1.0.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDownloadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "Get " & Chr$(34) & strFTPFilename & Chr$(34) & " " & Chr$(34) & strLocalFileName & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPDownloadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPDownloadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "FTP download failed" 300 strMailMessage = "The file: " & strFTPFilename & " did not download." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPDownloadFileWinSCP = False 370 End If 380 End If FTPDownloadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPDownloadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPDownloadFileWinSCP = False 470 Resume FTPDownloadFileWinSCP_Exit End Function Function FTPDeleteFileWinSCP(strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String) As Boolean ' Procedure to delete file on FTP site. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDeleteFileWinSCP" Const Version = "1.0.1.0" Dim strFTPCommandFile As String Dim strFTPScriptFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDeleteFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "rm " & Chr$(34) & strFTPFilename & Chr$(34) 110 Print #intFileNum, "Close" 120 Print #intFileNum, "Exit" 130 Close #intFileNum ' Write command file 140 intFileNum = FreeFile 150 Open strFTPCommandFile For Output As #intFileNum 160 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 170 Close #intFileNum ' Execute 180 lngHWnd = Shell(strFTPCommandFile, vbHide) 190 WaitWhileRunning (lngHWnd) ' Check log file 200 If IsValidFTPWinSCP(strFTPLogfile) Then 210 FTPDeleteFileWinSCP = True 220 Else 230 If DebugMode() = True Then 240 Stop 250 FTPDeleteFileWinSCP = False 260 Else 270 oOCS_SendMail.SetParams "ITALERT", ".", "." 280 oOCS_SendMail.Subject = "FTP Delete failed" 290 strMailMessage = "The file: " & strFTPFilename & " did not delete from the FTP site." & vbCrLf 300 strMailMessage = strMailMessage & "Command, script, and Log files are attached." & vbCrLf & vbCrLf 310 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 320 oOCS_SendMail.Message = strMailMessage 330 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 340 oOCS_SendMail.Send 350 FTPDeleteFileWinSCP = False 360 End If 370 End If FTPDeleteFileWinSCP_Exit: 380 On Error Resume Next 390 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 400 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 410 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 420 Close #intFileNum 430 Exit Function FTPDeleteFileWinSCP_Error: 440 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 450 Resume FTPDeleteFileWinSCP_Exit End Function -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From stuart at lexacorp.com.pg Fri Oct 9 17:41:01 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Sat, 10 Oct 2020 08:41:01 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <026601d69e7a$b6591b20$230b5160$@verizon.net> References: , <000201d69e72$31333c30$9399b490$@dalyn.co.nz>, <026601d69e7a$b6591b20$230b5160$@verizon.net> Message-ID: <5F80E6FD.27407.2E53CA1@stuart.lexacorp.com.pg> WinSCP doesn't have a separate MGET but GET does the job: https://winscp.net/eng/docs/scriptcommand_get#syntax Downloads one or more files from remote directory to local directory. If only one parameter is specified, downloads the file to local working directory. If more parameters are specified, all except the last one specify set of files to download. Filename can be replaced with wildcard to select multiple files. To download all files in a directory, use mask *. The last parameter specifies target local directory and optionally operation mask to store file(s) under different name. Target directory must end with backslash. To download more files to current working directory use .\ as the last parameter On 9 Oct 2020 at 16:28, Jim Dettman via AccessD wrote: > Most FTP clients have a MGET() / MPUT() ('M' for many) > command available. Not sure what WinSCP has available in that regard. From stuart at lexacorp.com.pg Fri Oct 9 17:44:10 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Sat, 10 Oct 2020 08:44:10 +1000 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <026601d69e7a$b6591b20$230b5160$@verizon.net> References: , <000201d69e72$31333c30$9399b490$@dalyn.co.nz>, <026601d69e7a$b6591b20$230b5160$@verizon.net> Message-ID: <5F80E7BA.9306.2E81D6E@stuart.lexacorp.com.pg> https://winscp.net/eng/docs/scriptcommand_synchronize SYNCHRONIZE When the first parameter is local, changes from remote directory are applied to local directory. When the first parameter is remote, changes from the local directory are applied to the remote directory. When the first parameter is both, both local and remote directories can be modified. When directories are not specified, current working directories are synchronized. On 9 Oct 2020 at 16:28, Jim Dettman via AccessD wrote: > 4. Some FTP clients now have a sync command, which keeps a local and > remote directory in sync. Might be of interest depending on what > your needs are. I believe WinSCP has such a command now. From newsgrps at dalyn.co.nz Sun Oct 11 01:00:57 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Sun, 11 Oct 2020 19:00:57 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <026601d69e7a$b6591b20$230b5160$@verizon.net> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> <01dd01d69e32$901d48c0$b057da40$@verizon.net> <000201d69e72$31333c30$9399b490$@dalyn.co.nz> <026601d69e7a$b6591b20$230b5160$@verizon.net> Message-ID: <003201d69f93$e534f3f0$af9edbd0$@dalyn.co.nz> Hi Jim, You refer to stripping out code such as WaitWhileRunning(). Does this pause execution until the Shell command is finished or does it do other things that are not directly relevant? By your extra comments you indicate I don't need it - presumably the code will work without it? Regards David Emerson Dalyn Software Ltd Wellington, New Zealand -----Original Message----- From: AccessD On Behalf Of Jim Dettman via AccessD Sent: Saturday, 10 October 2020 9:28 am To: AccessD List Cc: Jim Dettman Subject: Re: [AccessD] Transferring Files via FTP David, << Do you have WinSCP examples for getting files from and putting files up to a SFTP site?>> They are below. Some notes: 1. These are single file operations with a login/out for each file, which is highly inefficient if you have a lot of files to transfer. These were specifically written this way due to the nature of the application. Most FTP clients have a MGET() / MPUT() ('M' for many) command available. Not sure what WinSCP has available in that regard. 2. These routines were written over fifteen years ago. The commands available with WinSCP I'm sure have been changed/expanded. This code however does work today and is currently in production. 3. These routines do not employ any type of "guarding" (ensuring a file operation is complete). With FTP, there is no file locking available so it's possible that a file might be worked with (i.e. moved) before the transfer is complete. There are two ways to accomplish that: a. You create a "guard file" first, then delete it when done. i.e. myFile.grd is created, myFile.txt is transferred, and mfFile.grd is deleted. b. You send the file with a modified extension, then rename it when the send is complete. i.e. myFile.xfer becomes myFile.txt when done. Of course both ends must honor whatever method you use. Single file transfers are typically not a problem, unless the files are large. But you will run into this problem if you use any type of MGET()/MPUT() type process. I avoided a lot of problems by taking a directory snapshot first, then working with the files one by one, which is one reason why these routines are written the way they are. 4. Some FTP clients now have a sync command, which keeps a local and remote directory in sync. Might be of interest depending on what your needs are. I believe WinSCP has such a command now. 5. There's stuff in here that you won't have that you'll need to strip out (WaitWhileRunning (), sending of e-mails, and the error handler). Best of luck with the project, Jim. Function IsValidFTPWinSCP(strFTPLogfile As String) As Boolean ' Checks log file to see if last FTP operation OK. Const RoutineName = "IsValidFTPWinSCP" Const Version = "1.3" Dim intFileNum As Integer Dim lsLine As String 10 On Error GoTo IsValidFTPWinSCP_Error 20 IsValidFTPWinSCP = False 30 intFileNum = FreeFile 40 Open strFTPLogfile For Input As #intFileNum 50 Do While Not EOF(intFileNum) And IsValidFTPWinSCP = False 60 Line Input #intFileNum, lsLine 70 If InStr(lsLine, "result success=" & Chr$(34) & "true") > 0 Then IsValidFTPWinSCP = True 80 Loop IsValidFTPWinSCP_Exit: 90 On Error Resume Next 100 Close #intFileNum 110 Exit Function IsValidFTPWinSCP_Error: 120 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 130 Resume IsValidFTPWinSCP_Exit End Function Function FTPUploadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to upload file to FTP site. ' Uses WinSCP Client to upload File, which allows a SFTP transfer. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 2.2.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' Changed logging to XML format. Const RoutineName = "FTPUploadFileWinSCP" Const Version = "2.2.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPUploadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34) & " " & Chr$(34) & strFTPFilename & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPUploadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPUploadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "WinSCP FTP Upload failed." 300 strMailMessage = "The file: " & strLocalFileName & " did not upload." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPUploadFileWinSCP = False 370 End If 380 End If FTPUploadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPUploadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPUploadFileWinSCP = False 470 Resume FTPUploadFileWinSCP_Exit End Function Function FTPDownloadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to download a file from a FTP site. ' Sends e-mail to ITALERT if download fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDownloadFileWinSCP" Const Version = "1.0.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDownloadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "Get " & Chr$(34) & strFTPFilename & Chr$(34) & " " & Chr$(34) & strLocalFileName & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPDownloadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPDownloadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "FTP download failed" 300 strMailMessage = "The file: " & strFTPFilename & " did not download." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPDownloadFileWinSCP = False 370 End If 380 End If FTPDownloadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPDownloadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPDownloadFileWinSCP = False 470 Resume FTPDownloadFileWinSCP_Exit End Function Function FTPDeleteFileWinSCP(strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String) As Boolean ' Procedure to delete file on FTP site. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDeleteFileWinSCP" Const Version = "1.0.1.0" Dim strFTPCommandFile As String Dim strFTPScriptFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDeleteFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "rm " & Chr$(34) & strFTPFilename & Chr$(34) 110 Print #intFileNum, "Close" 120 Print #intFileNum, "Exit" 130 Close #intFileNum ' Write command file 140 intFileNum = FreeFile 150 Open strFTPCommandFile For Output As #intFileNum 160 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 170 Close #intFileNum ' Execute 180 lngHWnd = Shell(strFTPCommandFile, vbHide) 190 WaitWhileRunning (lngHWnd) ' Check log file 200 If IsValidFTPWinSCP(strFTPLogfile) Then 210 FTPDeleteFileWinSCP = True 220 Else 230 If DebugMode() = True Then 240 Stop 250 FTPDeleteFileWinSCP = False 260 Else 270 oOCS_SendMail.SetParams "ITALERT", ".", "." 280 oOCS_SendMail.Subject = "FTP Delete failed" 290 strMailMessage = "The file: " & strFTPFilename & " did not delete from the FTP site." & vbCrLf 300 strMailMessage = strMailMessage & "Command, script, and Log files are attached." & vbCrLf & vbCrLf 310 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 320 oOCS_SendMail.Message = strMailMessage 330 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 340 oOCS_SendMail.Send 350 FTPDeleteFileWinSCP = False 360 End If 370 End If FTPDeleteFileWinSCP_Exit: 380 On Error Resume Next 390 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 400 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 410 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 420 Close #intFileNum 430 Exit Function FTPDeleteFileWinSCP_Error: 440 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 450 Resume FTPDeleteFileWinSCP_Exit End Function -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From newsgrps at dalyn.co.nz Sun Oct 11 02:48:43 2020 From: newsgrps at dalyn.co.nz (David Emerson) Date: Sun, 11 Oct 2020 20:48:43 +1300 Subject: [AccessD] Transferring Files via FTP In-Reply-To: <003201d69f93$e534f3f0$af9edbd0$@dalyn.co.nz> References: , <003c01d69e16$a4615680$ed240380$@dalyn.co.nz>, <5F802C85.6863.CD558@stuart.lexacorp.com.pg> <5F802FEE.27387.1A2A79@stuart.lexacorp.com.pg> <01dd01d69e32$901d48c0$b057da40$@verizon.net> <000201d69e72$31333c30$9399b490$@dalyn.co.nz> <026601d69e7a$b6591b20$230b5160$@verizon.net> <003201d69f93$e534f3f0$af9edbd0$@dalyn.co.nz> Message-ID: <003301d69fa2$f3b7ddc0$db279940$@dalyn.co.nz> Solved my own question (always a good feeling). I needed to pause execution until the Shell command is finished so that the code to check the log could be run after the log was actually created. I have used some code I already have (thanks Stuart McLachlan) and it works so far. -----Original Message----- From: AccessD On Behalf Of David Emerson Sent: Sunday, 11 October 2020 7:01 pm To: 'Access Developers discussion and problem solving' Cc: 'Jim Dettman' Subject: Re: [AccessD] Transferring Files via FTP Hi Jim, You refer to stripping out code such as WaitWhileRunning(). Does this pause execution until the Shell command is finished or does it do other things that are not directly relevant? By your extra comments you indicate I don't need it - presumably the code will work without it? Regards David Emerson Dalyn Software Ltd Wellington, New Zealand -----Original Message----- From: AccessD On Behalf Of Jim Dettman via AccessD Sent: Saturday, 10 October 2020 9:28 am To: AccessD List Cc: Jim Dettman Subject: Re: [AccessD] Transferring Files via FTP David, << Do you have WinSCP examples for getting files from and putting files up to a SFTP site?>> They are below. Some notes: 1. These are single file operations with a login/out for each file, which is highly inefficient if you have a lot of files to transfer. These were specifically written this way due to the nature of the application. Most FTP clients have a MGET() / MPUT() ('M' for many) command available. Not sure what WinSCP has available in that regard. 2. These routines were written over fifteen years ago. The commands available with WinSCP I'm sure have been changed/expanded. This code however does work today and is currently in production. 3. These routines do not employ any type of "guarding" (ensuring a file operation is complete). With FTP, there is no file locking available so it's possible that a file might be worked with (i.e. moved) before the transfer is complete. There are two ways to accomplish that: a. You create a "guard file" first, then delete it when done. i.e. myFile.grd is created, myFile.txt is transferred, and mfFile.grd is deleted. b. You send the file with a modified extension, then rename it when the send is complete. i.e. myFile.xfer becomes myFile.txt when done. Of course both ends must honor whatever method you use. Single file transfers are typically not a problem, unless the files are large. But you will run into this problem if you use any type of MGET()/MPUT() type process. I avoided a lot of problems by taking a directory snapshot first, then working with the files one by one, which is one reason why these routines are written the way they are. 4. Some FTP clients now have a sync command, which keeps a local and remote directory in sync. Might be of interest depending on what your needs are. I believe WinSCP has such a command now. 5. There's stuff in here that you won't have that you'll need to strip out (WaitWhileRunning (), sending of e-mails, and the error handler). Best of luck with the project, Jim. Function IsValidFTPWinSCP(strFTPLogfile As String) As Boolean ' Checks log file to see if last FTP operation OK. Const RoutineName = "IsValidFTPWinSCP" Const Version = "1.3" Dim intFileNum As Integer Dim lsLine As String 10 On Error GoTo IsValidFTPWinSCP_Error 20 IsValidFTPWinSCP = False 30 intFileNum = FreeFile 40 Open strFTPLogfile For Input As #intFileNum 50 Do While Not EOF(intFileNum) And IsValidFTPWinSCP = False 60 Line Input #intFileNum, lsLine 70 If InStr(lsLine, "result success=" & Chr$(34) & "true") > 0 Then IsValidFTPWinSCP = True 80 Loop IsValidFTPWinSCP_Exit: 90 On Error Resume Next 100 Close #intFileNum 110 Exit Function IsValidFTPWinSCP_Error: 120 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 130 Resume IsValidFTPWinSCP_Exit End Function Function FTPUploadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to upload file to FTP site. ' Uses WinSCP Client to upload File, which allows a SFTP transfer. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 2.2.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' Changed logging to XML format. Const RoutineName = "FTPUploadFileWinSCP" Const Version = "2.2.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPUploadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34) & " " & Chr$(34) & strFTPFilename & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPUploadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPUploadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "WinSCP FTP Upload failed." 300 strMailMessage = "The file: " & strLocalFileName & " did not upload." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPUploadFileWinSCP = False 370 End If 380 End If FTPUploadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPUploadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPUploadFileWinSCP = False 470 Resume FTPUploadFileWinSCP_Exit End Function Function FTPDownloadFileWinSCP(strLocalFileName As String, strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String, Optional strTransferType As String) As Boolean ' Procedure to download a file from a FTP site. ' Sends e-mail to ITALERT if download fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDownloadFileWinSCP" Const Version = "1.0.1.0" Dim strFTPScriptFile As String Dim strFTPCommandFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDownloadFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "option transfer " & IIf(strTransferType = "B", "binary", "ascii") 110 Print #intFileNum, "Get " & Chr$(34) & strFTPFilename & Chr$(34) & " " & Chr$(34) & strLocalFileName & Chr$(34) 120 Print #intFileNum, "Close" 130 Print #intFileNum, "Exit" 140 Close #intFileNum ' Write command file 150 intFileNum = FreeFile 160 Open strFTPCommandFile For Output As #intFileNum 170 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 180 Close #intFileNum ' Execute 190 lngHWnd = Shell(strFTPCommandFile, vbHide) 200 WaitWhileRunning (lngHWnd) ' Check log file 210 If IsValidFTPWinSCP(strFTPLogfile) Then 220 FTPDownloadFileWinSCP = True 230 Else 240 If DebugMode() = True Then 250 Stop 260 FTPDownloadFileWinSCP = False 270 Else 280 oOCS_SendMail.SetParams "ITALERT", ".", "." 290 oOCS_SendMail.Subject = "FTP download failed" 300 strMailMessage = "The file: " & strFTPFilename & " did not download." & vbCrLf 310 strMailMessage = strMailMessage & "Command, script, and log files are attached." & vbCrLf & vbCrLf 320 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 330 oOCS_SendMail.Message = strMailMessage 340 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 350 oOCS_SendMail.Send 360 FTPDownloadFileWinSCP = False 370 End If 380 End If FTPDownloadFileWinSCP_Exit: 390 On Error Resume Next 400 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 410 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 420 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 430 Close #intFileNum 440 Exit Function FTPDownloadFileWinSCP_Error: 450 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 460 FTPDownloadFileWinSCP = False 470 Resume FTPDownloadFileWinSCP_Exit End Function Function FTPDeleteFileWinSCP(strFTPFilename As String, strFTPSiteName As String, strUserName As String, strPassword As String, strFTPSiteFingerprint As String) As Boolean ' Procedure to delete file on FTP site. ' Sends e-mail to ITALERT if upload fails and returns false. ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write. ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format. Const RoutineName = "FTPDeleteFileWinSCP" Const Version = "1.0.1.0" Dim strFTPCommandFile As String Dim strFTPScriptFile As String Dim strFTPLogfile As String Dim lngHWnd As Long Dim intFileNum As Integer Dim strMailMessage As String Dim oOCS_SendMail As New OCS_SendMail 10 On Error GoTo FTPDeleteFileWinSCP_Error ' Generate file names 20 strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".txt" 30 strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName & ".bat" 40 strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName & ".xml" ' Write script file 50 intFileNum = FreeFile 60 Open strFTPScriptFile For Output As #intFileNum 70 Print #intFileNum, "option batch on" 80 Print #intFileNum, "option confirm off" 90 Print #intFileNum, "open sftp://" & strUserName & ":" & strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) & strFTPSiteFingerprint & Chr$(34) 100 Print #intFileNum, "rm " & Chr$(34) & strFTPFilename & Chr$(34) 110 Print #intFileNum, "Close" 120 Print #intFileNum, "Exit" 130 Close #intFileNum ' Write command file 140 intFileNum = FreeFile 150 Open strFTPCommandFile For Output As #intFileNum 160 Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console /script=" & strFTPScriptFile & " /Log=" & strFTPLogfile 170 Close #intFileNum ' Execute 180 lngHWnd = Shell(strFTPCommandFile, vbHide) 190 WaitWhileRunning (lngHWnd) ' Check log file 200 If IsValidFTPWinSCP(strFTPLogfile) Then 210 FTPDeleteFileWinSCP = True 220 Else 230 If DebugMode() = True Then 240 Stop 250 FTPDeleteFileWinSCP = False 260 Else 270 oOCS_SendMail.SetParams "ITALERT", ".", "." 280 oOCS_SendMail.Subject = "FTP Delete failed" 290 strMailMessage = "The file: " & strFTPFilename & " did not delete from the FTP site." & vbCrLf 300 strMailMessage = strMailMessage & "Command, script, and Log files are attached." & vbCrLf & vbCrLf 310 strMailMessage = strMailMessage & "App name:" & AppShortName() & " Version: " & AppVersion() 320 oOCS_SendMail.Message = strMailMessage 330 oOCS_SendMail.Attachment = strFTPCommandFile & ";" & strFTPScriptFile & ";" & strFTPLogfile 340 oOCS_SendMail.Send 350 FTPDeleteFileWinSCP = False 360 End If 370 End If FTPDeleteFileWinSCP_Exit: 380 On Error Resume Next 390 If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile 400 If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile 410 If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile 420 Close #intFileNum 430 Exit Function FTPDeleteFileWinSCP_Error: 440 UnexpectedError ModuleName, RoutineName, Version, Err.Number, Err.Description, Err.Source, VBA.Erl 450 Resume FTPDeleteFileWinSCP_Exit End Function -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From KWilliamson at designcollective.com Fri Oct 16 08:05:42 2020 From: KWilliamson at designcollective.com (Keith Williamson) Date: Fri, 16 Oct 2020 13:05:42 +0000 Subject: [AccessD] Old-Time Member In-Reply-To: References: Message-ID: Hey guys, Hope you all might remember me. I've moved on to a new company, this year, and find myself (at least for now) involved again in utilizing MS Access for systems solutions. My current solution, I am working on, is to develop a planning module (to replace a very archaic Excel model) which collects and stores planned billings, by project, over the next 6-12 months. I'm looking to provide the PM's with a form that displays (filtered for them individually) their projects and each month's planned billings in a Crosstab format. So there would be rows of projects (with various information related to the project....Fee, YTD Billings, Backlog, etc).....but then columns of fields for monthly planned billings (Oct, Nov, Dec, Jan, etc.) The problem I have is that in order to get the format I want, it would need to be a Crosstab query, which isn't editable. Additionally, I want the form to ONLY show looking forward data. So, while the data would include what was planned for September.....I no longer want to present the past months on the form....only the current - future months. But they have to be able to edit, as circumstances change on the projects. Hopefully this makes sense. I'm asking if any of you can steer me in the right direction for approaching this? Should I use MS Access only for the tables needed to present the data, and store the actual planned billings....but use Excel as the front-end? Can I accomplish this (with variable monthly column headings) on a form, with the fields being editable? Thanks in advance for any feedback. Regards, Keith E. Williamson Chief Financial Officer 601 East Pratt Street, Suite 300 Baltimore, Maryland 21202 Tel 410.685.6655 | 100% Employee-Owned Design Firm www.designcollective.com [cid:image001.png at 01D6A39B.859B8AB0] [cid:image002.png at 01D6A39B.859B8AB0][cid:image003.png at 01D6A39B.859B8AB0][cid:image004.png at 01D6A39B.859B8AB0] From bensonforums at gmail.com Sun Oct 18 22:13:58 2020 From: bensonforums at gmail.com (Bill Benson) Date: Sun, 18 Oct 2020 23:13:58 -0400 Subject: [AccessD] Old-Time Member In-Reply-To: References: Message-ID: This may or may not be helpful to you... I agree that Crosstab queries are not "editable" but they can be redefined programmatically. I have done this before. I would run some VBA code to get the values (columns generally) I would be needing, then update the Crosstab QueryDef with new SQL and run it through OpenQuery after having modified it. On Fri, Oct 16, 2020 at 10:40 AM Keith Williamson < KWilliamson at designcollective.com> wrote: > Hey guys, > > Hope you all might remember me. I've moved on to a new company, this > year, and find myself (at least for now) involved again in utilizing MS > Access for systems solutions. My current solution, I am working on, is to > develop a planning module (to replace a very archaic Excel model) which > collects and stores planned billings, by project, over the next 6-12 > months. I'm looking to provide the PM's with a form that displays > (filtered for them individually) their projects and each month's planned > billings in a Crosstab format. So there would be rows of projects (with > various information related to the project....Fee, YTD Billings, Backlog, > etc).....but then columns of fields for monthly planned billings (Oct, Nov, > Dec, Jan, etc.) > > The problem I have is that in order to get the format I want, it would > need to be a Crosstab query, which isn't editable. Additionally, I want > the form to ONLY show looking forward data. So, while the data would > include what was planned for September.....I no longer want to present the > past months on the form....only the current - future months. But they have > to be able to edit, as circumstances change on the projects. > > Hopefully this makes sense. I'm asking if any of you can steer me in the > right direction for approaching this? Should I use MS Access only for the > tables needed to present the data, and store the actual planned > billings....but use Excel as the front-end? Can I accomplish this (with > variable monthly column headings) on a form, with the fields being editable? > > Thanks in advance for any feedback. > > Regards, > > Keith E. Williamson > Chief Financial Officer > > 601 East Pratt Street, Suite 300 > Baltimore, Maryland 21202 > Tel 410.685.6655 | 100% Employee-Owned Design Firm > www.designcollective.com > [cid:image001.png at 01D6A39B.859B8AB0] > [cid:image002.png at 01D6A39B.859B8AB0] >[cid:image003.png at 01D6A39B.859B8AB0]< > https://www.linkedin.com/company/design-collective-inc./ > >[cid:image004.png at 01D6A39B.859B8AB0]< > https://www.instagram.com/designcollectv> > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From gustav at cactus.dk Mon Oct 19 01:10:15 2020 From: gustav at cactus.dk (Gustav Brock) Date: Mon, 19 Oct 2020 06:10:15 +0000 Subject: [AccessD] Old-Time Member Message-ID: Hi Keith Welcome back! The reason a crosstab can't be edited is, that Access wouldn't know where to put the edits, as the original values are aggregated. You could write the output of the crosstab to a temporary table, then present this. Those records and fields can be edited, but it will be up to you to decide which table(s) should be updated. If the field to be updated is a sum, you can update the addends of this. It's a delicate process to do right, but should you need it, I've prepared it for you. It is the function RoundSum found in my project VBA.Round: Rounding a series of numbers to a sum https://github.com/GustavBrock/VBA.Round /gustav -----Oprindelig meddelelse----- Fra: AccessD P? vegne af Keith Williamson Sendt: 16. oktober 2020 15:06 Til: accessd at databaseadvisors.com Emne: [AccessD] Old-Time Member Hey guys, Hope you all might remember me. I've moved on to a new company, this year, and find myself (at least for now) involved again in utilizing MS Access for systems solutions. My current solution, I am working on, is to develop a planning module (to replace a very archaic Excel model) which collects and stores planned billings, by project, over the next 6-12 months. I'm looking to provide the PM's with a form that displays (filtered for them individually) their projects and each month's planned billings in a Crosstab format. So there would be rows of projects (with various information related to the project....Fee, YTD Billings, Backlog, etc).....but then columns of fields for monthly planned billings (Oct, Nov, Dec, Jan, etc.) The problem I have is that in order to get the format I want, it would need to be a Crosstab query, which isn't editable. Additionally, I want the form to ONLY show looking forward data. So, while the data would include what was planned for September.....I no longer want to present the past months on the form....only the current - future months. But they have to be able to edit, as circumstances change on the projects. Hopefully this makes sense. I'm asking if any of you can steer me in the right direction for approaching this? Should I use MS Access only for the tables needed to present the data, and store the actual planned billings....but use Excel as the front-end? Can I accomplish this (with variable monthly column headings) on a form, with the fields being editable? Thanks in advance for any feedback. Regards, Keith E. Williamson Chief Financial Officer 601 East Pratt Street, Suite 300 Baltimore, Maryland 21202 Tel 410.685.6655 | 100% Employee-Owned Design Firm www.designcollective.com [cid:image001.png at 01D6A39B.859B8AB0] [cid:image002.png at 01D6A39B.859B8AB0][cid:image003.png at 01D6A39B.859B8AB0][cid:image004.png at 01D6A39B.859B8AB0] From KWilliamson at designcollective.com Mon Oct 19 16:16:13 2020 From: KWilliamson at designcollective.com (Keith Williamson) Date: Mon, 19 Oct 2020 21:16:13 +0000 Subject: [AccessD] Old-Time Member In-Reply-To: References: Message-ID: Thanks all....a couple good responses. I think either a temporary table, or using Excel as the front end....Looks like I'm going to have to exercise my frontal lobes on remembering how to do all this. ? The reality is the Crosstab is for presentation only....there is only one number in the source data per column/row intersect. I'm setting the data up such that there is a column from project number, column for month, and column for amount. So...if I have 6 months of projections for a project, there are six rows of monthly projections. I'm just wanting to present that as one row of projections, with 6 columns (for each month) across the top. Ideally....the project manager could go in and edit those projects (as presented.) Albeit...the PM will probably have multiple projects...so they could have multiple rows (one for each project) x 6 columns. I'll play with all your suggestions to see what might work best. May be more questions coming. Thanks for the time to respond! Keith E. Williamson Chief Financial Officer 601 East Pratt Street, Suite 300 Baltimore, Maryland 21202 Tel 410.685.6655 | 100% Employee-Owned Design Firm www.designcollective.com -----Original Message----- From: AccessD On Behalf Of Gustav Brock via AccessD Sent: Monday, October 19, 2020 2:10 AM To: Access Developers discussion and problem solving Cc: Gustav Brock Subject: Re: [AccessD] Old-Time Member [THIS EMAIL IS FROM AN EXTERNAL SENDER] Hi Keith Welcome back! The reason a crosstab can't be edited is, that Access wouldn't know where to put the edits, as the original values are aggregated. You could write the output of the crosstab to a temporary table, then present this. Those records and fields can be edited, but it will be up to you to decide which table(s) should be updated. If the field to be updated is a sum, you can update the addends of this. It's a delicate process to do right, but should you need it, I've prepared it for you. It is the function RoundSum found in my project VBA.Round: Rounding a series of numbers to a sum https://urldefense.proofpoint.com/v2/url?u=https-3A__github.com_GustavBrock_VBA.Round&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=5iu2MrB4mvnPs-5oTi6fUJIyLAb3oSQnfYblxarLsaI&e= /gustav -----Oprindelig meddelelse----- Fra: AccessD P? vegne af Keith Williamson Sendt: 16. oktober 2020 15:06 Til: accessd at databaseadvisors.com Emne: [AccessD] Old-Time Member Hey guys, Hope you all might remember me. I've moved on to a new company, this year, and find myself (at least for now) involved again in utilizing MS Access for systems solutions. My current solution, I am working on, is to develop a planning module (to replace a very archaic Excel model) which collects and stores planned billings, by project, over the next 6-12 months. I'm looking to provide the PM's with a form that displays (filtered for them individually) their projects and each month's planned billings in a Crosstab format. So there would be rows of projects (with various information related to the project....Fee, YTD Billings, Backlog, etc).....but then columns of fields for monthly planned billings (Oct, Nov, Dec, Jan, etc.) The problem I have is that in order to get the format I want, it would need to be a Crosstab query, which isn't editable. Additionally, I want the form to ONLY show looking forward data. So, while the data would include what was planned for September.....I no longer want to present the past months on the form....only the current - future months. But they have to be able to edit, as circumstances change on the projects. Hopefully this makes sense. I'm asking if any of you can steer me in the right direction for approaching this? Should I use MS Access only for the tables needed to present the data, and store the actual planned billings....but use Excel as the front-end? Can I accomplish this (with variable monthly column headings) on a form, with the fields being editable? Thanks in advance for any feedback. Regards, Keith E. Williamson Chief Financial Officer 601 East Pratt Street, Suite 300 Baltimore, Maryland 21202 Tel 410.685.6655 | 100% Employee-Owned Design Firm www.designcollective.com [cid:image001.png at 01D6A39B.859B8AB0] [cid:image002.png at 01D6A39B.859B8AB0][cid:image003.png at 01D6A39B.859B8AB0][cid:image004.png at 01D6A39B.859B8AB0] -- AccessD mailing list AccessD at databaseadvisors.com https://urldefense.proofpoint.com/v2/url?u=http-3A__databaseadvisors.com_mailman_listinfo_accessd&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=pWI5aVnWrq1UIBAQkHcH2656B-gvEVmEHnu0v2VWlDo&e= Website: https://urldefense.proofpoint.com/v2/url?u=http-3A__www.databaseadvisors.com&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=_6nfuvbbUtQahzQxfOQgskSOqImy-nGUsj7eC-SKiCg&e= From garykjos at gmail.com Mon Oct 19 16:31:04 2020 From: garykjos at gmail.com (Gary Kjos) Date: Mon, 19 Oct 2020 16:31:04 -0500 Subject: [AccessD] Old-Time Member In-Reply-To: References: Message-ID: I was wondering about the use of the cross tab. You could also make some sub queries - one that selected the data for each month and then make another query that used the individual monthly sub queries as it's input and walla, you have all 6 months on a single row. And it's probably editable since it's not aggregate. I used to use queries within other queries all the time. Good luck! GK On Mon, Oct 19, 2020 at 4:17 PM Keith Williamson < KWilliamson at designcollective.com> wrote: > Thanks all....a couple good responses. I think either a temporary table, > or using Excel as the front end....Looks like I'm going to have to exercise > my frontal lobes on remembering how to do all this. ? > > The reality is the Crosstab is for presentation only....there is only one > number in the source data per column/row intersect. I'm setting the data > up such that there is a column from project number, column for month, and > column for amount. So...if I have 6 months of projections for a project, > there are six rows of monthly projections. I'm just wanting to present > that as one row of projections, with 6 columns (for each month) across the > top. Ideally....the project manager could go in and edit those projects > (as presented.) Albeit...the PM will probably have multiple projects...so > they could have multiple rows (one for each project) x 6 columns. I'll > play with all your suggestions to see what might work best. May be more > questions coming. > > Thanks for the time to respond! > > Keith E. Williamson > Chief Financial Officer > > 601 East Pratt Street, Suite 300 > Baltimore, Maryland 21202 > Tel 410.685.6655 | 100% Employee-Owned Design Firm > www.designcollective.com > > > > -----Original Message----- > From: AccessD On Behalf Of Gustav > Brock via AccessD > Sent: Monday, October 19, 2020 2:10 AM > To: Access Developers discussion and problem solving < > accessd at databaseadvisors.com> > Cc: Gustav Brock > Subject: Re: [AccessD] Old-Time Member > > > [THIS EMAIL IS FROM AN EXTERNAL SENDER] > > Hi Keith > > Welcome back! > > The reason a crosstab can't be edited is, that Access wouldn't know where > to put the edits, as the original values are aggregated. > You could write the output of the crosstab to a temporary table, then > present this. Those records and fields can be edited, but it will be up to > you to decide which table(s) should be updated. > If the field to be updated is a sum, you can update the addends of this. > It's a delicate process to do right, but should you need it, I've prepared > it for you. It is the function RoundSum found in my project VBA.Round: > > Rounding a series of numbers to a sum > > https://urldefense.proofpoint.com/v2/url?u=https-3A__github.com_GustavBrock_VBA.Round&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=5iu2MrB4mvnPs-5oTi6fUJIyLAb3oSQnfYblxarLsaI&e= > > /gustav > > -----Oprindelig meddelelse----- > Fra: AccessD P? vegne af Keith > Williamson > Sendt: 16. oktober 2020 15:06 > Til: accessd at databaseadvisors.com > Emne: [AccessD] Old-Time Member > > Hey guys, > > Hope you all might remember me. I've moved on to a new company, this > year, and find myself (at least for now) involved again in utilizing MS > Access for systems solutions. My current solution, I am working on, is to > develop a planning module (to replace a very archaic Excel model) which > collects and stores planned billings, by project, over the next 6-12 > months. I'm looking to provide the PM's with a form that displays > (filtered for them individually) their projects and each month's planned > billings in a Crosstab format. So there would be rows of projects (with > various information related to the project....Fee, YTD Billings, Backlog, > etc).....but then columns of fields for monthly planned billings (Oct, Nov, > Dec, Jan, etc.) > > The problem I have is that in order to get the format I want, it would > need to be a Crosstab query, which isn't editable. Additionally, I want > the form to ONLY show looking forward data. So, while the data would > include what was planned for September.....I no longer want to present the > past months on the form....only the current - future months. But they have > to be able to edit, as circumstances change on the projects. > > Hopefully this makes sense. I'm asking if any of you can steer me in the > right direction for approaching this? Should I use MS Access only for the > tables needed to present the data, and store the actual planned > billings....but use Excel as the front-end? Can I accomplish this (with > variable monthly column headings) on a form, with the fields being editable? > > Thanks in advance for any feedback. > > Regards, > > Keith E. Williamson > Chief Financial Officer > > 601 East Pratt Street, Suite 300 > Baltimore, Maryland 21202 > Tel 410.685.6655 | 100% Employee-Owned Design Firm > www.designcollective.com [cid:image001.png at 01D6A39B.859B8AB0] > [cid:image002.png at 01D6A39B.859B8AB0]< > https://urldefense.proofpoint.com/v2/url?u=https-3A__twitter.com_designcollectv&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=lzBxw9c8lo0N85b3AsB2lOV6ZwDWlenJPbOw6fWhQIc&e= > >[cid:image003.png at 01D6A39B.859B8AB0]< > https://urldefense.proofpoint.com/v2/url?u=https-3A__www.linkedin.com_company_design-2Dcollective-2Dinc._&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=NhZgUEmLFEpVPIRgN4WRgU5V8a3AAt5tp4fNKQCKdHM&e= > >[cid:image004.png at 01D6A39B.859B8AB0]< > https://urldefense.proofpoint.com/v2/url?u=https-3A__www.instagram.com_designcollectv&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=sXxRyBLa3H0zYQWg9gYVINmGknBpNzhZdClmX5bmMNs&e= > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > > https://urldefense.proofpoint.com/v2/url?u=http-3A__databaseadvisors.com_mailman_listinfo_accessd&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=pWI5aVnWrq1UIBAQkHcH2656B-gvEVmEHnu0v2VWlDo&e= > Website: > https://urldefense.proofpoint.com/v2/url?u=http-3A__www.databaseadvisors.com&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=_6nfuvbbUtQahzQxfOQgskSOqImy-nGUsj7eC-SKiCg&e= > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Gary Kjos garykjos at gmail.com From df.waters at outlook.com Mon Oct 19 16:36:59 2020 From: df.waters at outlook.com (Daniel Waters) Date: Mon, 19 Oct 2020 21:36:59 +0000 Subject: [AccessD] Old-Time Member In-Reply-To: References: Message-ID: Hi Keith, I was asked once to set up a method to allow engineers to enter their hours by project and by day. So for each week they would have multiple projects per day and each day had to have 8 hours of time. I did use a crosstab query to create the data structure for display, but like you're seeing I couldn't use that as the datasource for an editable form. To make it work, I set the crosstab query to populate a temporary table and set the temporary table as the data source for the form. When the form was edited by an engineer, that triggered some code that modified data in the permanent table, triggered the crosstab query, repopulated the temp table, and redisplayed the form. Took some work but it ran well! Good luck with your project! Dan -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Keith Williamson Sent: 19 October, 2020 16:16 To: Access Developers discussion and problem solving Cc: Gustav Brock Subject: Re: [AccessD] Old-Time Member Thanks all....a couple good responses. I think either a temporary table, or using Excel as the front end....Looks like I'm going to have to exercise my frontal lobes on remembering how to do all this. ? The reality is the Crosstab is for presentation only....there is only one number in the source data per column/row intersect. I'm setting the data up such that there is a column from project number, column for month, and column for amount. So...if I have 6 months of projections for a project, there are six rows of monthly projections. I'm just wanting to present that as one row of projections, with 6 columns (for each month) across the top. Ideally....the project manager could go in and edit those projects (as presented.) Albeit...the PM will probably have multiple projects...so they could have multiple rows (one for each project) x 6 columns. I'll play with all your suggestions to see what might work best. May be more questions coming. Thanks for the time to respond! Keith E. Williamson Chief Financial Officer 601 East Pratt Street, Suite 300 Baltimore, Maryland 21202 Tel 410.685.6655 | 100% Employee-Owned Design Firm www.designcollective.com -----Original Message----- From: AccessD On Behalf Of Gustav Brock via AccessD Sent: Monday, October 19, 2020 2:10 AM To: Access Developers discussion and problem solving Cc: Gustav Brock Subject: Re: [AccessD] Old-Time Member [THIS EMAIL IS FROM AN EXTERNAL SENDER] Hi Keith Welcome back! The reason a crosstab can't be edited is, that Access wouldn't know where to put the edits, as the original values are aggregated. You could write the output of the crosstab to a temporary table, then present this. Those records and fields can be edited, but it will be up to you to decide which table(s) should be updated. If the field to be updated is a sum, you can update the addends of this. It's a delicate process to do right, but should you need it, I've prepared it for you. It is the function RoundSum found in my project VBA.Round: Rounding a series of numbers to a sum https://urldefense.proofpoint.com/v2/url?u=https-3A__github.com_GustavBrock_VBA.Round&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=5iu2MrB4mvnPs-5oTi6fUJIyLAb3oSQnfYblxarLsaI&e= /gustav -----Oprindelig meddelelse----- Fra: AccessD P? vegne af Keith Williamson Sendt: 16. oktober 2020 15:06 Til: accessd at databaseadvisors.com Emne: [AccessD] Old-Time Member Hey guys, Hope you all might remember me. I've moved on to a new company, this year, and find myself (at least for now) involved again in utilizing MS Access for systems solutions. My current solution, I am working on, is to develop a planning module (to replace a very archaic Excel model) which collects and stores planned billings, by project, over the next 6-12 months. I'm looking to provide the PM's with a form that displays (filtered for them individually) their projects and each month's planned billings in a Crosstab format. So there would be rows of projects (with various information related to the project....Fee, YTD Billings, Backlog, etc).....but then columns of fields for monthly planned billings (Oct, Nov, Dec, Jan, etc.) The problem I have is that in order to get the format I want, it would need to be a Crosstab query, which isn't editable. Additionally, I want the form to ONLY show looking forward data. So, while the data would include what was planned for September.....I no longer want to present the past months on the form....only the current - future months. But they have to be able to edit, as circumstances change on the projects. Hopefully this makes sense. I'm asking if any of you can steer me in the right direction for approaching this? Should I use MS Access only for the tables needed to present the data, and store the actual planned billings....but use Excel as the front-end? Can I accomplish this (with variable monthly column headings) on a form, with the fields being editable? Thanks in advance for any feedback. Regards, Keith E. Williamson Chief Financial Officer 601 East Pratt Street, Suite 300 Baltimore, Maryland 21202 Tel 410.685.6655 | 100% Employee-Owned Design Firm www.designcollective.com [cid:image001.png at 01D6A39B.859B8AB0] [cid:image002.png at 01D6A39B.859B8AB0][cid:image003.png at 01D6A39B.859B8AB0][cid:image004.png at 01D6A39B.859B8AB0] -- AccessD mailing list AccessD at databaseadvisors.com https://urldefense.proofpoint.com/v2/url?u=http-3A__databaseadvisors.com_mailman_listinfo_accessd&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=pWI5aVnWrq1UIBAQkHcH2656B-gvEVmEHnu0v2VWlDo&e= Website: https://urldefense.proofpoint.com/v2/url?u=http-3A__www.databaseadvisors.com&d=DwIFAw&c=euGZstcaTDllvimEN8b7jXrwqOf-v5A_CdpgnVfiiMM&r=cCa049KXg2Due8I6xkXzoVrfvG83jjeYLf7LB9M_3qY&m=RvpYxUTFCg21jpL8CBhMlP8Vf_h2bXdGfglwICJUf-I&s=_6nfuvbbUtQahzQxfOQgskSOqImy-nGUsj7eC-SKiCg&e= -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From rockysmolin2 at gmail.com Wed Oct 21 10:59:58 2020 From: rockysmolin2 at gmail.com (rocky smolin) Date: Wed, 21 Oct 2020 08:59:58 -0700 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields Message-ID: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> Dear List: I have a client running a db I made for him which has a table of 30 fields. He wants to identify duplicate records meaning all 30 fields (excluding the PK of course). But the duplicate query wizard has a limit of 10 fields. So I think this needs a piece of VBA code. Does anyone have a good procedure for doing this? MTIA, Rocky Smolin Beach Access Software 760-683-5777 From paul.hartland at googlemail.com Wed Oct 21 11:18:15 2020 From: paul.hartland at googlemail.com (Paul Hartland) Date: Wed, 21 Oct 2020 17:18:15 +0100 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> Message-ID: Rocky, Can you not just write a bit of vba code to connect to the database and have some sql like below run and return the results to a recordset select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 from yourtable group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 having count(*)> 1 Paul Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> On Wed, 21 Oct 2020 at 17:01, rocky smolin wrote: > Dear List: > > > > I have a client running a db I made for him which has a table of 30 fields. > He wants to identify duplicate records meaning all 30 fields (excluding the > PK of course). But the duplicate query wizard has a limit of 10 fields. > So > I think this needs a piece of VBA code. > > > > Does anyone have a good procedure for doing this? > > > > MTIA, > > > > > > Rocky Smolin > > Beach Access Software > > 760-683-5777 > > > > > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Paul Hartland paul.hartland at googlemail.com From rockysmolin2 at gmail.com Wed Oct 21 11:46:15 2020 From: rockysmolin2 at gmail.com (rocky smolin) Date: Wed, 21 Oct 2020 09:46:15 -0700 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> Message-ID: <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> Paul: I think that worked. But it only identified one duplicate. I'll have to ask the client to send me the latest back end and give me examples of duplicates that he knows of. Since he wants this change, I'm assuming he's seeing more than a couple duplicates. Next problem is to find the PKs these two (or more) so I can present them to him in a form and he can select one to delete. Thanks and regards, Rocky -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Paul Hartland via AccessD Sent: Wednesday, October 21, 2020 9:18 AM To: Access Developers discussion and problem solving Cc: Paul Hartland Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Rocky, Can you not just write a bit of vba code to connect to the database and have some sql like below run and return the results to a recordset select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 from yourtable group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 having count(*)> 1 Paul Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> On Wed, 21 Oct 2020 at 17:01, rocky smolin wrote: > Dear List: > > > > I have a client running a db I made for him which has a table of 30 fields. > He wants to identify duplicate records meaning all 30 fields (excluding the > PK of course). But the duplicate query wizard has a limit of 10 fields. > So > I think this needs a piece of VBA code. > > > > Does anyone have a good procedure for doing this? > > > > MTIA, > > > > > > Rocky Smolin > > Beach Access Software > > 760-683-5777 > > > > > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Paul Hartland paul.hartland at googlemail.com -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From paul.hartland at googlemail.com Wed Oct 21 12:29:59 2020 From: paul.hartland at googlemail.com (Paul Hartland) Date: Wed, 21 Oct 2020 18:29:59 +0100 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> Message-ID: Rocky, you could have something like select a.* from yourtable as a join (theduplicatequeryhere) as b on a.f1 = b.f1 and a.f2 = b.f2 etc for all the 30 fields Paul Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> On Wed, 21 Oct 2020 at 17:47, rocky smolin wrote: > Paul: > > I think that worked. But it only identified one duplicate. I'll have to > ask > the client to send me the latest back end and give me examples of > duplicates > that he knows of. Since he wants this change, I'm assuming he's seeing > more > than a couple duplicates. > > Next problem is to find the PKs these two (or more) so I can present them > to > him in a form and he can select one to delete. > > Thanks and regards, > > Rocky > > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > Paul Hartland via AccessD > Sent: Wednesday, October 21, 2020 9:18 AM > To: Access Developers discussion and problem solving > Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > 10 > fields > > Rocky, > > Can you not just write a bit of vba code to connect to the database and > have some sql like below run and return the results to a recordset > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > from yourtable > group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > having count(*)> 1 > > Paul > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:01, rocky smolin wrote: > > > Dear List: > > > > > > > > I have a client running a db I made for him which has a table of 30 > fields. > > He wants to identify duplicate records meaning all 30 fields (excluding > the > > PK of course). But the duplicate query wizard has a limit of 10 fields. > > So > > I think this needs a piece of VBA code. > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > MTIA, > > > > > > > > > > > > Rocky Smolin > > > > Beach Access Software > > > > 760-683-5777 > > > > > > > > > > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Paul Hartland paul.hartland at googlemail.com Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> From rockysmolin2 at gmail.com Wed Oct 21 12:57:47 2020 From: rockysmolin2 at gmail.com (rocky smolin) Date: Wed, 21 Oct 2020 10:57:47 -0700 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> Message-ID: <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> Paul: The table at the moment has only 116 records and as time goes on it may have several hundred - less if the user deletes the old records - this is a task list and the tasks that are in the past could probably be deleted. So maybe it would be just as efficient to create a recordset using that extended WHERE statement for each record (tblTask.fld1 = val of current tblTask.fld1...etc.), check if the recordset has more than one record, and, if so add the PKs to a temp table (assuming they're not already there) and then present the results by joining the PK of the temp table to the PK of the Task table? Tks r -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Paul Hartland via AccessD Sent: Wednesday, October 21, 2020 10:30 AM To: Access Developers discussion and problem solving Cc: Paul Hartland Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Rocky, you could have something like select a.* from yourtable as a join (theduplicatequeryhere) as b on a.f1 = b.f1 and a.f2 = b.f2 etc for all the 30 fields Paul Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> On Wed, 21 Oct 2020 at 17:47, rocky smolin wrote: > Paul: > > I think that worked. But it only identified one duplicate. I'll have to > ask > the client to send me the latest back end and give me examples of > duplicates > that he knows of. Since he wants this change, I'm assuming he's seeing > more > than a couple duplicates. > > Next problem is to find the PKs these two (or more) so I can present them > to > him in a form and he can select one to delete. > > Thanks and regards, > > Rocky > > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > Paul Hartland via AccessD > Sent: Wednesday, October 21, 2020 9:18 AM > To: Access Developers discussion and problem solving > Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > 10 > fields > > Rocky, > > Can you not just write a bit of vba code to connect to the database and > have some sql like below run and return the results to a recordset > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > from yourtable > group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > having count(*)> 1 > > Paul > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:01, rocky smolin wrote: > > > Dear List: > > > > > > > > I have a client running a db I made for him which has a table of 30 > fields. > > He wants to identify duplicate records meaning all 30 fields (excluding > the > > PK of course). But the duplicate query wizard has a limit of 10 fields. > > So > > I think this needs a piece of VBA code. > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > MTIA, > > > > > > > > > > > > Rocky Smolin > > > > Beach Access Software > > > > 760-683-5777 > > > > > > > > > > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Paul Hartland paul.hartland at googlemail.com Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From paul.hartland at googlemail.com Wed Oct 21 13:17:41 2020 From: paul.hartland at googlemail.com (Paul Hartland) Date: Wed, 21 Oct 2020 19:17:41 +0100 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> Message-ID: Rocky, Yeah sounds ok unless someone comes up with something better. Glad I could help. Paul On Wed, 21 Oct 2020, 18:58 rocky smolin, wrote: > Paul: > > The table at the moment has only 116 records and as time goes on it may > have > several hundred - less if the user deletes the old records - this is a task > list and the tasks that are in the past could probably be deleted. > > So maybe it would be just as efficient to create a recordset using that > extended WHERE statement for each record (tblTask.fld1 = val of current > tblTask.fld1...etc.), check if the recordset has more than one record, and, > if so add the PKs to a temp table (assuming they're not already there) and > then present the results by joining the PK of the temp table to the PK of > the Task table? > > Tks > > r > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > Paul Hartland via AccessD > Sent: Wednesday, October 21, 2020 10:30 AM > To: Access Developers discussion and problem solving > Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > 10 > fields > > Rocky, > you could have something like > > select a.* > from yourtable as a > join (theduplicatequeryhere) as b > on a.f1 = b.f1 and a.f2 = b.f2 etc for all the 30 fields > > Paul > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:47, rocky smolin wrote: > > > Paul: > > > > I think that worked. But it only identified one duplicate. I'll have to > > ask > > the client to send me the latest back end and give me examples of > > duplicates > > that he knows of. Since he wants this change, I'm assuming he's seeing > > more > > than a couple duplicates. > > > > Next problem is to find the PKs these two (or more) so I can present them > > to > > him in a form and he can select one to delete. > > > > Thanks and regards, > > > > Rocky > > > > > > -----Original Message----- > > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > > Paul Hartland via AccessD > > Sent: Wednesday, October 21, 2020 9:18 AM > > To: Access Developers discussion and problem solving > > Cc: Paul Hartland > > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > > 10 > > fields > > > > Rocky, > > > > Can you not just write a bit of vba code to connect to the database and > > have some sql like below run and return the results to a recordset > > > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > > from yourtable > > group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, > f15, > > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > > having count(*)> 1 > > > > Paul > > > > < > > > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > > paign=sig-email&utm_content=webmail > > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > > > > > Virus-free. > > www.avg.com > > < > > > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > > paign=sig-email&utm_content=webmail > > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > > > On Wed, 21 Oct 2020 at 17:01, rocky smolin > wrote: > > > > > Dear List: > > > > > > > > > > > > I have a client running a db I made for him which has a table of 30 > > fields. > > > He wants to identify duplicate records meaning all 30 fields (excluding > > the > > > PK of course). But the duplicate query wizard has a limit of 10 > fields. > > > So > > > I think this needs a piece of VBA code. > > > > > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > > > > > MTIA, > > > > > > > > > > > > > > > > > > Rocky Smolin > > > > > > Beach Access Software > > > > > > 760-683-5777 > > > > > > > > > > > > > > > > > > > > > > > > -- > > > AccessD mailing list > > > AccessD at databaseadvisors.com > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > Website: http://www.databaseadvisors.com > > > > > > > > > -- > > Paul Hartland > > paul.hartland at googlemail.com > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From charlotte.foust at gmail.com Wed Oct 21 13:23:54 2020 From: charlotte.foust at gmail.com (Charlotte Foust) Date: Wed, 21 Oct 2020 11:23:54 -0700 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> Message-ID: I don't have any code on hand, but I recall building that kind of search in an application doing data cleanup. I addressed it by concatenating the fields into a pipe (|) delimited string and comparing strings. Charlotte Foust (916) 206-4336 On Wed, Oct 21, 2020 at 9:00 AM rocky smolin wrote: > Dear List: > > > > I have a client running a db I made for him which has a table of 30 fields. > He wants to identify duplicate records meaning all 30 fields (excluding the > PK of course). But the duplicate query wizard has a limit of 10 fields. > So > I think this needs a piece of VBA code. > > > > Does anyone have a good procedure for doing this? > > > > MTIA, > > > > > > Rocky Smolin > > Beach Access Software > > 760-683-5777 > > > > > > > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From jamesbutton at blueyonder.co.uk Wed Oct 21 14:42:21 2020 From: jamesbutton at blueyonder.co.uk (James Button) Date: Wed, 21 Oct 2020 20:42:21 +0100 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> Message-ID: Firstly, with the results being just the entries that are repeated (not just duplicated) shouldn't the script be which to keep rather than which to delete. Then again if there are any other data columns in the rows with repeated keys, then shouldn't the cleanup process also facilitate a merge, or selection of the required other data And - more 'the thing to do' stop the problem occurring - Stop duplicate entries being created in the first place Also consider the effect on any associated tables and other processes of deleting a (Parent?) PK entry - depending on what the PK is actually generated by/from But that's just me being picky in a VV&Y/UAT mode JimB -----Original Message----- From: AccessD On Behalf Of rocky smolin Sent: Wednesday, October 21, 2020 6:58 PM To: 'Access Developers discussion and problem solving' Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Paul: The table at the moment has only 116 records and as time goes on it may have several hundred - less if the user deletes the old records - this is a task list and the tasks that are in the past could probably be deleted. So maybe it would be just as efficient to create a recordset using that extended WHERE statement for each record (tblTask.fld1 = val of current tblTask.fld1...etc.), check if the recordset has more than one record, and, if so add the PKs to a temp table (assuming they're not already there) and then present the results by joining the PK of the temp table to the PK of the Task table? Tks r -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Paul Hartland via AccessD Sent: Wednesday, October 21, 2020 10:30 AM To: Access Developers discussion and problem solving Cc: Paul Hartland Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Rocky, you could have something like select a.* from yourtable as a join (theduplicatequeryhere) as b on a.f1 = b.f1 and a.f2 = b.f2 etc for all the 30 fields Paul Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> On Wed, 21 Oct 2020 at 17:47, rocky smolin wrote: > Paul: > > I think that worked. But it only identified one duplicate. I'll have to > ask > the client to send me the latest back end and give me examples of > duplicates > that he knows of. Since he wants this change, I'm assuming he's seeing > more > than a couple duplicates. > > Next problem is to find the PKs these two (or more) so I can present them > to > him in a form and he can select one to delete. > > Thanks and regards, > > Rocky > > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > Paul Hartland via AccessD > Sent: Wednesday, October 21, 2020 9:18 AM > To: Access Developers discussion and problem solving > Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > 10 > fields > > Rocky, > > Can you not just write a bit of vba code to connect to the database and > have some sql like below run and return the results to a recordset > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > from yourtable > group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > having count(*)> 1 > > Paul > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:01, rocky smolin wrote: > > > Dear List: > > > > > > > > I have a client running a db I made for him which has a table of 30 > fields. > > He wants to identify duplicate records meaning all 30 fields (excluding > the > > PK of course). But the duplicate query wizard has a limit of 10 fields. > > So > > I think this needs a piece of VBA code. > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > MTIA, > > > > > > > > > > > > Rocky Smolin > > > > Beach Access Software > > > > 760-683-5777 > > > > > > > > > > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Paul Hartland paul.hartland at googlemail.com Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From rockysmolin2 at gmail.com Wed Oct 21 14:48:10 2020 From: rockysmolin2 at gmail.com (rocky smolin) Date: Wed, 21 Oct 2020 12:48:10 -0700 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> Message-ID: <004b01d6a7e3$1b69c660$523d5320$@gmail.com> He specifies that a duplicate record is one in which every field is identical to another record. The record in this table has about 10 FKs so deleting a record doesn't produce any orphans. You're right that Stopping duplicate entries should be done before the update, but that won't work for him. r -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of James Button via AccessD Sent: Wednesday, October 21, 2020 12:42 PM To: 'Access Developers discussion and problem solving' Cc: James Button Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Firstly, with the results being just the entries that are repeated (not just duplicated) shouldn't the script be which to keep rather than which to delete. Then again if there are any other data columns in the rows with repeated keys, then shouldn't the cleanup process also facilitate a merge, or selection of the required other data And - more 'the thing to do' stop the problem occurring - Stop duplicate entries being created in the first place Also consider the effect on any associated tables and other processes of deleting a (Parent?) PK entry - depending on what the PK is actually generated by/from But that's just me being picky in a VV&Y/UAT mode JimB -----Original Message----- From: AccessD On Behalf Of rocky smolin Sent: Wednesday, October 21, 2020 6:58 PM To: 'Access Developers discussion and problem solving' Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Paul: The table at the moment has only 116 records and as time goes on it may have several hundred - less if the user deletes the old records - this is a task list and the tasks that are in the past could probably be deleted. So maybe it would be just as efficient to create a recordset using that extended WHERE statement for each record (tblTask.fld1 = val of current tblTask.fld1...etc.), check if the recordset has more than one record, and, if so add the PKs to a temp table (assuming they're not already there) and then present the results by joining the PK of the temp table to the PK of the Task table? Tks r -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Paul Hartland via AccessD Sent: Wednesday, October 21, 2020 10:30 AM To: Access Developers discussion and problem solving Cc: Paul Hartland Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Rocky, you could have something like select a.* from yourtable as a join (theduplicatequeryhere) as b on a.f1 = b.f1 and a.f2 = b.f2 etc for all the 30 fields Paul Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> On Wed, 21 Oct 2020 at 17:47, rocky smolin wrote: > Paul: > > I think that worked. But it only identified one duplicate. I'll have to > ask > the client to send me the latest back end and give me examples of > duplicates > that he knows of. Since he wants this change, I'm assuming he's seeing > more > than a couple duplicates. > > Next problem is to find the PKs these two (or more) so I can present them > to > him in a form and he can select one to delete. > > Thanks and regards, > > Rocky > > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > Paul Hartland via AccessD > Sent: Wednesday, October 21, 2020 9:18 AM > To: Access Developers discussion and problem solving > Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > 10 > fields > > Rocky, > > Can you not just write a bit of vba code to connect to the database and > have some sql like below run and return the results to a recordset > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > from yourtable > group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > having count(*)> 1 > > Paul > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:01, rocky smolin wrote: > > > Dear List: > > > > > > > > I have a client running a db I made for him which has a table of 30 > fields. > > He wants to identify duplicate records meaning all 30 fields (excluding > the > > PK of course). But the duplicate query wizard has a limit of 10 fields. > > So > > I think this needs a piece of VBA code. > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > MTIA, > > > > > > > > > > > > Rocky Smolin > > > > Beach Access Software > > > > 760-683-5777 > > > > > > > > > > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- Paul Hartland paul.hartland at googlemail.com Virus-free. www.avg.com <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com From stuart at lexacorp.com.pg Wed Oct 21 16:08:45 2020 From: stuart at lexacorp.com.pg (Stuart McLachlan) Date: Thu, 22 Oct 2020 07:08:45 +1000 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com>, , <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> Message-ID: <5F90A35D.17914.7A3FFE6@stuart.lexacorp.com.pg> SELECT Count(Key) AS CountOfKey, First(Key) AS FirstOfKey, Last(Key) AS LastOfKey,f2,f3,f4,f5.... FROM tblMyTable GROUP BY f2,f3,f4,f5...; HAVING Count(Key)>1; On 21 Oct 2020 at 9:46, rocky smolin wrote: > Paul: > > I think that worked. But it only identified one duplicate. I'll have > to ask the client to send me the latest back end and give me examples > of duplicates that he knows of. Since he wants this change, I'm > assuming he's seeing more than a couple duplicates. > > Next problem is to find the PKs these two (or more) so I can present > them to him in a form and he can select one to delete. > > Thanks and regards, > > Rocky > > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf > Of Paul Hartland via AccessD Sent: Wednesday, October 21, 2020 9:18 AM > To: Access Developers discussion and problem solving Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more > than 10 fields > > Rocky, > > Can you not just write a bit of vba code to connect to the database > and have some sql like below run and return the results to a recordset > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, > f15, f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, > f29, f30 from yourtable group by f1, f2, f3, f4, f5, f6, f7, f8, f9, > f10, f11, f12, f13, f14, f15, f16, f17, f18, f19, f20, f21, f22, f23, > f24, f25, f26, f27, f28, f29, f30 having count(*)> 1 > > Paul > > tm_cam paign=sig-email&utm_content=webmail> Virus-free. www.avg.com > tm_cam paign=sig-email&utm_content=webmail> > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:01, rocky smolin > wrote: > > > Dear List: > > > > > > > > I have a client running a db I made for him which has a table of 30 > fields. > > He wants to identify duplicate records meaning all 30 fields > > (excluding > the > > PK of course). But the duplicate query wizard has a limit of 10 > > fields. So I think this needs a piece of VBA code. > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > MTIA, > > > > > > > > > > > > Rocky Smolin > > > > Beach Access Software > > > > 760-683-5777 > > > > > > > > > > > > > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > From rockysmolin2 at gmail.com Sat Oct 24 12:09:10 2020 From: rockysmolin2 at gmail.com (rocky smolin) Date: Sat, 24 Oct 2020 10:09:10 -0700 Subject: [AccessD] Finding Duplicate Records when there are more than 10 fields In-Reply-To: References: <001c01d6a7c3$3ab6d410$b0247c30$@gmail.com> <002a01d6a7c9$b1c919e0$155b4da0$@gmail.com> <003101d6a7d3$aff0cbe0$0fd263a0$@gmail.com> Message-ID: <003c01d6aa28$64ad6fb0$2e084f10$@gmail.com> Dear List: So here's the code that identifies the duplicate records - duplicate being defined as EVERY field in the two subject records is identical - in case someone runs into the same requirement. I did it in a nested loop so that each pair would be tested only once. It's a bit brute force but it works fast enough for the user. The PK of the duplicates ends up in a front end table and from there I will display them to the user so that he can select which one(s) to delete. Haven't written that part yet. Private Sub cmdDuplicates_Click() Set db = CurrentDb db.Execute "Delete * FROM tblDuplicateTaskIDs" Set rsDuplicates = db.OpenRecordset("Select * FROM tblDuplicateTaskIDs") Set rsDup1 = db.OpenRecordset("Select * FROM tblTasks ORDER BY fldTaskID") Do While rsDup1.EOF = False Set rsDup2 = db.OpenRecordset("Select * FROM tblTasks WHERE fldTaskID > " & rsDup1!fldTaskID & " ORDER BY fldTaskID") Do While rsDup2.EOF = False If fnDuplicate = True Then rsDuplicates.AddNew rsDuplicates!fldDuplicateTaskID = rsDup1!fldTaskID rsDuplicates.Update rsDuplicates.AddNew rsDuplicates!fldDuplicateTaskID = rsDup2!fldTaskID rsDuplicates.Update End If NextDup2: rsDup2.MoveNext Loop NextDup1: rsDup1.MoveNext Loop MsgBox "Done" HTH Rocky -----Original Message----- From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Paul Hartland via AccessD Sent: Wednesday, October 21, 2020 11:18 AM To: Access Developers discussion and problem solving Cc: Paul Hartland Subject: Re: [AccessD] Finding Duplicate Records when there are more than 10 fields Rocky, Yeah sounds ok unless someone comes up with something better. Glad I could help. Paul On Wed, 21 Oct 2020, 18:58 rocky smolin, wrote: > Paul: > > The table at the moment has only 116 records and as time goes on it may > have > several hundred - less if the user deletes the old records - this is a task > list and the tasks that are in the past could probably be deleted. > > So maybe it would be just as efficient to create a recordset using that > extended WHERE statement for each record (tblTask.fld1 = val of current > tblTask.fld1...etc.), check if the recordset has more than one record, and, > if so add the PKs to a temp table (assuming they're not already there) and > then present the results by joining the PK of the temp table to the PK of > the Task table? > > Tks > > r > > -----Original Message----- > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > Paul Hartland via AccessD > Sent: Wednesday, October 21, 2020 10:30 AM > To: Access Developers discussion and problem solving > Cc: Paul Hartland > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > 10 > fields > > Rocky, > you could have something like > > select a.* > from yourtable as a > join (theduplicatequeryhere) as b > on a.f1 = b.f1 and a.f2 = b.f2 etc for all the 30 fields > > Paul > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > On Wed, 21 Oct 2020 at 17:47, rocky smolin wrote: > > > Paul: > > > > I think that worked. But it only identified one duplicate. I'll have to > > ask > > the client to send me the latest back end and give me examples of > > duplicates > > that he knows of. Since he wants this change, I'm assuming he's seeing > > more > > than a couple duplicates. > > > > Next problem is to find the PKs these two (or more) so I can present them > > to > > him in a form and he can select one to delete. > > > > Thanks and regards, > > > > Rocky > > > > > > -----Original Message----- > > From: AccessD [mailto:accessd-bounces at databaseadvisors.com] On Behalf Of > > Paul Hartland via AccessD > > Sent: Wednesday, October 21, 2020 9:18 AM > > To: Access Developers discussion and problem solving > > Cc: Paul Hartland > > Subject: Re: [AccessD] Finding Duplicate Records when there are more than > > 10 > > fields > > > > Rocky, > > > > Can you not just write a bit of vba code to connect to the database and > > have some sql like below run and return the results to a recordset > > > > select f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, > > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > > from yourtable > > group by f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, > f15, > > f16, f17, f18, f19, f20, f21, f22, f23, f24, f25, f26, f27, f28, f29, f30 > > having count(*)> 1 > > > > Paul > > > > < > > > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > > paign=sig-email&utm_content=webmail > > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > > > > > Virus-free. > > www.avg.com > > < > > > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > > paign=sig-email&utm_content=webmail > > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > > > > On Wed, 21 Oct 2020 at 17:01, rocky smolin > wrote: > > > > > Dear List: > > > > > > > > > > > > I have a client running a db I made for him which has a table of 30 > > fields. > > > He wants to identify duplicate records meaning all 30 fields (excluding > > the > > > PK of course). But the duplicate query wizard has a limit of 10 > fields. > > > So > > > I think this needs a piece of VBA code. > > > > > > > > > > > > Does anyone have a good procedure for doing this? > > > > > > > > > > > > MTIA, > > > > > > > > > > > > > > > > > > Rocky Smolin > > > > > > Beach Access Software > > > > > > 760-683-5777 > > > > > > > > > > > > > > > > > > > > > > > > -- > > > AccessD mailing list > > > AccessD at databaseadvisors.com > > > http://databaseadvisors.com/mailman/listinfo/accessd > > > Website: http://www.databaseadvisors.com > > > > > > > > > -- > > Paul Hartland > > paul.hartland at googlemail.com > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > -- > > AccessD mailing list > > AccessD at databaseadvisors.com > > http://databaseadvisors.com/mailman/listinfo/accessd > > Website: http://www.databaseadvisors.com > > > > > -- > Paul Hartland > paul.hartland at googlemail.com > > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > Virus-free. > www.avg.com > < > http://www.avg.com/email-signature?utm_medium=email&utm_source=link&utm_cam > paign=sig-email&utm_content=webmail > > > > <#DAB4FAD8-2DD7-40BB-A1B8-4E2AA1F9FDF2> > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > > -- > AccessD mailing list > AccessD at databaseadvisors.com > http://databaseadvisors.com/mailman/listinfo/accessd > Website: http://www.databaseadvisors.com > -- AccessD mailing list AccessD at databaseadvisors.com http://databaseadvisors.com/mailman/listinfo/accessd Website: http://www.databaseadvisors.com