VBA for Integration Manager to Insert Vendor EFT Bank And Email Addresses

I did a SQL Script back in October 2014 which allowed Vendor EFT Details to be inserted, but, if the client is going to run it themselves, requires the assistance of the IT Department as end users don’t usually have access to SQL Server Management Studio.

For most clients, this hasn’t usually been a problem, but a number of the clients I have worked with recently have had multiple projects on the go at the same time. This has meant that while an IT representative can be available, it isn’t usually very timely and can delay UAT.

As such, I wrote some VBA script for Integration Manager which inserts both the Vendor Email and EFT Details.

The script is in two parts.

The first part, sets up the ODBC connection for the company into which the user is logged. This script is attached to the Before Integration hook on the integration itself:

/*
Created by Ian Grieve of azurecurve|Ramblings of a Dynamics GP Consultant (https://www.azurecurve.co.uk)
This code is licensed under the Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International (CC BY-NC-SA 4.0 Int).
*/
' BEFORE INTEGRATION
Dim oCon
Dim sINTERID

Set oCon = CreateObject("ADODB.Connection")
oCon.ConnectionString = "database=" & GPConnection.GPConnIntercompanyID
GPConnection.Open(oCon)

SetVariable "gblConn", oCon

The second script, I attach to the UPS Zone field on the Addresses node within the Destination Mapping. It sets the UPS Zone field to the value from the source file, retrieves the ODBC connection, inserts or updates the EFT Details as appropriate and then does the same for the email address:

/*
Created by Ian Grieve of azurecurve|Ramblings of a Dynamics GP Consultant (https://www.azurecurve.co.uk)
This code is licensed under the Creative Commons Attribution-NonCommercial-ShareAlike 4.0 International (CC BY-NC-SA 4.0 Int).
*/
' Addresses - UPS Zone
CurrentField = SourceFields("Vendor Addresses.UPS Zone")

Dim sPath
Set oCmd = CreateObject("ADODB.Command")
With oCmd

	.ActiveConnection = GetVariable("gblConn")
	
	'EFT
	If Len(Trim(SourceFields("Vendor Addresses.Bank Account Number"))) > 0 Then
		sEFTVENDORID = UCase(SourceFields("Vendor Addresses.Vendor ID"))
		sEFTADRSCODE = UCase(SourceFields("Vendor Addresses.Address Code"))
		.CommandText = "SELECT COUNT(EFTBankAcct) AS Count FROM SY06000 WHERE SERIES = 4 AND VENDORID = '" & sEFTVENDORID & "' AND ADRSCODE = '" & sEFTADRSCODE & "'"
		Set rsQuery = .Execute

		If Not (rsQuery.EOF and rsQuery.BOF) Then
		
		'msgbox rsQuery("Count") & "-"  & .CommandText
			If rsQuery("Count") > 0 Then
				.CommandText = "UPDATE " & _
									"SY06000 " & _
								"SET " & _
									"BANKNAME = '" & SourceFields("Vendor Addresses.Bank Name") & "', EFTBankCode = '" & RIGHT("000000" &  SourceFields("Vendor Addresses.Bank Sort Code"), 6) & "', EFTBankAcct = '" & RIGHT("00000000" & SourceFields("Vendor Addresses.Bank Account Number"), 8) & "' " & _
								"WHERE " & _
									"VENDORID = '" & sEFTVENDORID & "' AND ADRSCODE = '" & sEFTADRSCODE & "'"
				Set rsUpdate = .Execute
			Else
				.CommandText = "INSERT SY06000 " & _
									"(SERIES,CustomerVendor_ID,ADRSCODE,VENDORID,CUSTNMBR,EFTUseMasterID,EFTBankType,FRGNBANK,INACTIVE,BANKNAME,EFTBankAcct,EFTBankBranch,GIROPostType,EFTBankCode,EFTBankBranchCode,EFTBankCheckDigit,BSROLLNO,IntlBankAcctNum,SWIFTADDR,CustVendCountryCode,DeliveryCountryCode,BNKCTRCD,CBANKCD,ADDRESS1,ADDRESS2,ADDRESS3,ADDRESS4,RegCode1,RegCode2,BankInfo7,EFTTransitRoutingNo,CURNCYID,EFTTransferMethod,EFTAccountType,EFTPrenoteDate,EFTTerminationDate) " & _
								"VALUES " & _
									"(4,'" & sEFTVENDORID & "','" & sEFTADRSCODE & "','" & sEFTVENDORID & "','',1,3,0,0,'" & SourceFields("Vendor Addresses.Bank Name") & "','" & RIGHT("00000000" & SourceFields("Vendor Addresses.Bank Account Number"), 8) & "','',0,'" & RIGHT("000000" & SourceFields("Vendor Addresses.Bank Sort Code"), 6) & "','','','','','','','','','','','','','','','',0,'','',1,1,'1900-01-01 00:00:00.000','1900-01-01 00:00:00.000')"
				Set rsInsert = .Execute
			End If
		End If
		rsQuery.Close
	End If
	
	' EMAIL
	If Len(Trim(SourceFields("Vendor Addresses.Email To"))) > 0 Then
		sEmailVENDORID = UCase(SourceFields("Vendor Addresses.Vendor ID"))
		sEmailADRSCODE = UCase(SourceFields("Vendor Addresses.Address Code"))
		.CommandText = "SELECT COUNT(Master_Type) AS Count FROM SY01200 WHERE Master_Type = 'VEN' AND Master_ID = '" & sEmailVENDORID & "' AND ADRSCODE = '" & sEmailADRSCODE & "'"
		Set rsQuery = .Execute

		If Not (rsQuery.EOF and rsQuery.BOF) Then
			If rsQuery("Count") > 0 Then
				.CommandText = "UPDATE " & _
									"SY01200 " & _
								"SET " & _
									"EmailToAddress = '" & SourceFields("Vendor Addresses.Email To") & "', EmailCcAddress = '" & SourceFields("Vendor Addresses.Email Cc") & "', EmailBccAddress = '" & SourceFields("Vendor Addresses.Email Bcc") & "' " & _
								"WHERE " & _
									"Master_Type = 'VEN' AND Master_ID = '" & sEmailVENDORID & "' AND ADRSCODE = '" & sEmailADRSCODE & "'"
				Set rsUpdate = .Execute
			Else
				.CommandText = "INSERT SY01200 " & _
									"(Master_Type,Master_ID,ADRSCODE,EmailToAddress,EmailCcAddress,EmailBccAddress,INETINFO) " & _
								"VALUES " & _
									"('VEN','" & sEmailVENDORID & "','" & sEmailADRSCODE & "','" & SourceFields("Vendor Addresses.Email To") & "','" & SourceFields("Vendor Addresses.Email Cc") & "','" & SourceFields("Vendor Addresses.Email Bcc") & "','')"
				Set rsInsert = .Execute
			End If
		End If
		rsQuery.Close
	End If
End With
Set oCmd = Nothing

I have had occasional crashing problems with the script on a minority of clients, but it generally runs fine. When it does crash, it is usually after 1,000 rows.

The workaround is to remove the lines which have been integrated and restart the script.