Double Handling within working code Write to access and fire access macro

**robtuby** · 02-11-2015, 09:08 AM

Hi

I have put this together but i dont think it is optimal.
The Macro is calling another Sub (UploadParameterDates) (i have done this seperatly as i may need to call just this macro)
The code then creates an access object to fire a 7 stage access macro (Various update queries etc) then closes down access

Please could you see if it could be refined? would excell handle the queries im running within access?

Which metod would boost performance of the code? using Excel to call the macro from access or Excel doing the queries?

Thanks

Code for UploadParameter Dates

Sub UploadParameterDates()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Control").Visible = True
Sheets("Control").Select
Dim CN As Object
Dim StrDatabase As String
Dim StrWorkbook As String
Dim StrTableName As String

StrTableName = "dates"
StrDatabase = "I:\Outage Planning\YearAhead\DataBase\YAP Reporting Database.accdb"
StrWorkbook = ThisWorkbook.FullName

Set CN = CreateObject("ADODB.Connection")
With CN
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & StrDatabase
.Open
.Execute "Delete * From Dates"
.Execute "INSERT INTO Dates(C1) SELECT * FROM [Excel 12.0;HDR=YES;Database=" & StrWorkbook & "].[Control$ag1:Ag400]"
.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End With

End Sub

Code to be optimised/Edited


Sub Uploader()
Dim iRet As Integer
    Dim strPrompt As String
    Dim strTitle As String
    strPrompt = "By continuing, any new values will be added to the main database." & vbCrLf & _
"Are you sure you want to upload?"
    strTitle = "CRITICAL! Main Database Update Pending!"
    iRet = MsgBox(strPrompt, vbSystemModal + vbCritical + vbYesNo + vbDefaultButton2, strTitle)
    If iRet = vbNo Then
        MsgBox "Cancelled!"
    Else
    Dim iRet2 As Integer
    Dim strPrompt2 As String
    Dim strTitle2 As String
    strPrompt2 = "Are you sure you wish to continue?"
    strTitle2 = "CRITICAL!, Main Database Update Pending"
    iRet2 = MsgBox(strPrompt2, vbSystemModal + vbCritical + vbYesNo + vbDefaultButton2, strTitle2)
    If iRet2 = vbNo Then
        MsgBox "Cancelled!"
    Else
  Application.ScreenUpdating = False
  Sheets("Control").Visible = True
  Call UploadParameterDates
'do i need both objects?
Dim A As Object
Dim CN As Object
Dim StrDatabase As String
Dim StrWorkbook As String
Dim StrTableName As String
StrDatabase = "i:\outage planning\YearAhead\Database\YAP Reporting Database.accdb"
StrWorkbook = ThisWorkbook.FullName
Set CN = CreateObject("ADODB.Connection")
With CN
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & StrDatabase
.Open
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set A = CreateObject("Access.Application")
A.Visible = False
A.OpenCurrentDatabase ("i:\outage planning\YearAhead\Database\YAP Reporting Database.accdb")
A.DoCmd.RunMacro "uploadMacro"
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End With
Application.ScreenUpdating = True
End If
End If
  Sheets("Control").Select
MsgBox "Uploaded", vbInformation = vbOKOnly, "Upload Completed"
End Sub

**Norie** · 02-11-2015, 09:14 AM

Couldn't you do everything in Access, or Excel?

**robtuby** · 02-11-2015, 09:20 AM

I Believe I could but i would need some support converting the access queries that are running so they would work in Excel.

Ive posted some examples below of the queries in access.

UPDATE Dates INNER JOIN Archive ON Dates.Dates = Archive.CalendarDate SET Archive.PlanYr = IIf([Archive].[CalendarDate]=[Dates].[Dates],1,0);

DELETE Archive.*, Archive.UploadDate, Archive.PlanYr
FROM Archive
WHERE (((Archive.UploadDate)=Date()) AND ((Archive.PlanYr)="1"));

INSERT INTO Archive ( CalendarDate, Details, Name, funct, TeamName, Location, Location2, Skill, UploadDate )
SELECT Dates.Dates, dbo_tbl_activity.Details, dbo_tbl_staff.Name, dbo_tbl_function.funct, dbo_tbl_cluster.TeamName, dbo_tbl_location.Location, dbo_tbl_location.LocationCode, dbo_tbl_skill.Skill, Date() AS Expr1
FROM Dates INNER JOIN ((((dbo_tbl_function INNER JOIN (dbo_tbl_activitytype INNER JOIN (dbo_tbl_activity INNER JOIN dbo_tbl_staff ON dbo_tbl_activity.idstaff = dbo_tbl_staff.id) ON dbo_tbl_activitytype.id = dbo_tbl_activity.Activitytype) ON dbo_tbl_function.id = dbo_tbl_staff.Funct) INNER JOIN dbo_tbl_cluster ON dbo_tbl_staff.Cluster = dbo_tbl_cluster.id) INNER JOIN dbo_tbl_location ON dbo_tbl_activity.Location = dbo_tbl_location.id) INNER JOIN dbo_tbl_skill ON dbo_tbl_staff.Skill = dbo_tbl_skill.id) ON Dates.Dates = dbo_tbl_activity.StartDate;

[/CODE]
UPDATE Archive SET Archive.HashTag = (IIf(IsNull([Details]),"#Free",IIf(InStr([Details],"#")>0,IIf(InStr(InStr([Details],"#"),[Details]," ")>0,Mid([Details],InStr([Details],"#"),InStr(InStr([Details],"#"),[Details]," ")-InStr([Details],"#")),Mid([Details],InStr([Details],"#"),999)),IIf(InStr([Details],"Bank Holiday")>0,"#hols",IIf(InStr([Details],"Holiday")>0 Or InStr([Details],"Leave")>0,"#Hols",IIf(InStr([Details],"Training")>0,"#Trng",IIf(InStr([Details],"Routine")>0,"#ROUT",IIf(InStr([Details],"left")>0,"#left",IIf(InStr([Details],"Directed")>0,"",IIf(InStr([Details],"Dutie")>0,"#Other",IIf(InStr([Details],"prep")>0,"#Prep",IIf(InStr([Details],"maint")>0,"#mtce"))))))))))))
WHERE (((Archive.HashTag) Is Null) AND ((Archive.UploadDate)=Date()));

[/CODE]

**Norie** · 02-11-2015, 09:35 AM

I don't see why you shouldn't be able to execute those queries just are you are executing these queries.

.Execute "Delete * From Dates"
.Execute "INSERT INTO Dates(C1) SELECT * FROM [Excel 12.0;HDR=YES;Database=" & StrWorkbook & "].[Control$ag1:Ag400]"

I might even be tempted to try using the query names rather than the SQL.

**robtuby** · 02-11-2015, 09:54 AM

its the arger of the queries i will struggle with where they are not importing or deteting data such as

UPDATE Archive SET Archive.HashTag = (IIf(IsNull([Details]),"#Free",IIf(InStr([Details],"#")>0,IIf(InStr(InStr([Details],"#"),[Details]," ")>0,Mid([Details],InStr([Details],"#"),InStr(InStr([Details],"#"),[Details]," ")-InStr([Details],"#")),Mid([Details],InStr([Details],"#"),999)),IIf(InStr([Details],"Bank Holiday")>0,"#hols",IIf(InStr([Details],"Holiday")>0 Or InStr([Details],"Leave")>0,"#Hols",IIf(InStr([Details],"Training")>0,"#Trng",IIf(InStr([Details],"Routine")>0,"#ROUT",IIf(InStr([Details],"left")>0,"#left",IIf(InStr([Details],"Directed")>0,"",IIf(InStr([Details],"Dutie")>0,"#Other",IIf(InStr([Details],"prep")>0,"#Prep",IIf(InStr([Details],"maint")>0,"#mtce"))))))))))))
WHERE (((Archive.HashTag) Is Null) AND ((Archive.UploadDate)=Date()));

**Norie** · 02-11-2015, 11:42 AM

What would be the problem with running that query from Excel?

**robtuby** · 02-11-2015, 11:51 AM

There shouldnt be a problem, Ive just been trying this since your last post

What ive done is:

Open the Access DB.
Gone into the Query Design mode and SQL view (Ive posted the SQL below)
Pasted into VB and added .Execute and the Speech marks .

Ive getting errors such as syntax, Doesnt like "*" or any of the other speech marks.

Any ideas?

SQL's Below


.Execute "UPDATE Dates INNER JOIN Archive ON Dates.Dates = Archive.CalendarDate SET Archive.PlanYr = IIf([Archive].[CalendarDate]=[Dates].[Dates],1,0)"
'_________________________________

' Not working from Here 
.Execute "DELETE Archive.*, Archive.UploadDate, Archive.PlanYr FROM Archive WHERE (((Archive.UploadDate)=Date()) AND ((Archive.PlanYr)="1"))

'_________________________________

.Execute "INSERT INTO Archive ( CalendarDate, Details, Name, funct, TeamName, Location, Location2, Skill, UploadDate ) SELECT Dates.Dates, dbo_tbl_activity.Details, dbo_tbl_staff.Name, dbo_tbl_function.funct, dbo_tbl_cluster.TeamName, dbo_tbl_location.Location, dbo_tbl_location.LocationCode, dbo_tbl_skill.Skill, Date() AS Expr1 FROM Dates INNER JOIN ((((dbo_tbl_function INNER JOIN (dbo_tbl_activitytype INNER JOIN (dbo_tbl_activity INNER JOIN dbo_tbl_staff ON dbo_tbl_activity.idstaff = dbo_tbl_staff.id) ON dbo_tbl_activitytype.id = dbo_tbl_activity.Activitytype) ON dbo_tbl_function.id = dbo_tbl_staff.Funct) INNER JOIN dbo_tbl_cluster ON dbo_tbl_staff.Cluster = dbo_tbl_cluster.id) INNER JOIN dbo_tbl_location ON dbo_tbl_activity.Location = dbo_tbl_location.id) INNER JOIN dbo_tbl_skill ON dbo_tbl_staff.Skill = dbo_tbl_skill.id) ON Dates.Dates = dbo_tbl_activity.StartDate"

'_________________________________

.Execute "SELECT Archive.funct INTO test FROM Archive GROUP BY Archive.funct"

'_________________________________

.Execute "DELETE test.*, test.Funct FROM test WHERE (((test.Funct)in(Select [region].[Region] from [Region])))"

'_________________________________

.Execute "DELETE Archive.*, Archive.Funct FROM Archive WHERE (((Archive.Funct) In (Select [test].[funct] from [test])))"

'_________________________________

.Execute "UPDATE Archive SET Archive.HashTag = (IIf(IsNull([Details]),"#Free",IIf(InStr([Details],"#")>0,IIf(InStr(InStr([Details],"#"),[Details]," ")>0,Mid([Details],InStr([Details],"#"),InStr(InStr([Details],"#"),[Details]," ")-InStr([Details],"#")),Mid([Details],InStr([Details],"#"),999)),IIf(InStr([Details],"Bank Holiday")>0,"#hols",IIf(InStr([Details],"Holiday")>0 Or InStr([Details],"Leave")>0,"#Hols",IIf(InStr([Details],"Training")>0,"#Trng",IIf(InStr([Details],"Routine")>0,"#ROUT",IIf(InStr([Details],"left")>0,"#left",IIf(InStr([Details],"Directed")>0,"",IIf(InStr([Details],"Dutie")>0,"#Other",IIf(InStr([Details],"prep")>0,"#Prep",IIf(InStr([Details],"maint")>0,"#mtce")))))))))))) WHERE (((Archive.HashTag) Is Null) AND ((Archive.UploadDate)=Date()))"

'_________________________________

.Execute "UPDATE TBLhashtag INNER JOIN Archive ON TBLhashtag.HashTag = Archive.HashTag SET Archive.Description = (IIf([TBLhashtag].[HashTag]=[Archive].[HashTag],[TBLhashtag].[Description])), Archive.WorkType = ([TBLhashtag].[WorkType])

**Norie** · 02-11-2015, 11:55 AM

In the query change the " to '.

**robtuby** · 02-11-2015, 12:19 PM

This one is Erroring with a Runtime ?????

.Execute "UPDATE Archive SET Archive.HashTag = (IIf(IsNull([Details]),'#Free',IIf(InStr([Details],'#')>0,IIf(InStr(InStr([Details],'#'),[Details],' ')>0,Mid([Details],InStr([Details],'#'),InStr(InStr([Details],'#'),[Details],' ')-InStr([Details],'#')),Mid([Details],InStr([Details],'#'),999)),IIf(InStr([Details],'Bank Holiday')>0,'#hols',IIf(InStr([Details],'Holiday')>0 Or InStr([Details],'Leave')>0,'#Hols',IIf(InStr([Details],'Training')>0,'#Trng',IIf(InStr([Details],'Routine')>0,'#ROUT',IIf(InStr([Details],'left')>0,'#left',IIf(InStr([Details],'Directed')>0,"",IIf(InStr([Details],'Dutie')>0,'#Other',IIf(InStr([Details],'prep')>0,'#Prep',IIf(InStr([Details],'maint')>0,'#mtce')))))))))))) WHERE (((Archive.HashTag) Is Null) AND ((Archive.UploadDate)=Date()))"

Double Handling within working code Write to access and fire access macro

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Re: Double Handling within working code Write to access and fire access macro

Thread Information

Users Browsing this Thread

Similar Threads

Access form works with access Viewer but not full version of Access?

Is it possible to write macro to access multiple workbook in a directory

Make the code working for Access backend

Only execute code on a write-access basis, not read-only

Fire Access Make-Table Query from Excel

Bookmarks

Bookmarks

Posting Permissions