W16

W16

关注
发信
关注(28)粉丝(399)

如何在Excel / VBA中将增量计数（版本）添加到字符串（文件）中？

本文介绍了如何在Excel / VBA中将增量计数（版本）添加到字符串（文件）中？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我尝试了很多不同的东西，似乎我不能让它工作。所以基本上，这是我的完整代码的一小块。

我使用 Microsoft Scripting Runtime 保存文件，使用FileExists（）在保存之前检查文件是否真的存在。

如果我删除IF语句/ Loop，那么这是正常工作。

然而，现在感觉像 FileExists 在使用IF / Loop运行时找不到字符串 MyFilePath 。 （getdirsubparentpath是一个函数）

I have tried a lot of different things, and it seems like I cannot get it to work. So basically, this is a small piece of my complete code.
I am using Microsoft Scripting Runtime to save the file, using the FileExists() to check if the file actually exist before saving.
This is working fine if I remove the IF-statement/Loop.
However, now it feels like FileExists won´t find the string, MyFilePath, when I run it with the IF/Loop. (getdirsubparentpath is a function)

Dim week, UserName As String
Dim MyFile, MyFilePath As String
Dim version As Integer


' Current week, XX
week = Format(Date, "ww")
' Username, e.g. niclas.madsen
UserName = Environ$("UserName")
' Initials, first letter of last and surname to caps
' e.g. niclas.madsen would be NM
UserName = UCase(Left(UserName, 1) & Mid(UserName, InStr(UserName, ".") + 1, 1))

' fix filename for saving purpose
MyFile = Replace(Replace("SupplierOrganization_W", "", ""), ".", "_") _
        & "" _
        & week _
        & " " _
        & UserName _
        & ".csv"
'SupplierOrganization_WXX NM

MyFilePath = getDirSubParentPath & MyFile

' Look for the MyFilePath, if it exists then
' Add "-1" after the week number, if 1 exists, add 2, etc.
If Len(Dir(MyFilePath)) <> 0 Then
version = 0
Do
version = version + 1
MyFilePath = Dir(getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv")
Loop Until Len(Dir(MyFilePath)) < 0
End If

Dim tmpFile, tmpFilePath As String
tmpFile = getDirSubParentPath & "tmp_file.txt"


Dim tmpString As String
'Dim fso As New FileSystemObject


Dim fso As Object 'scripting.filesystemobject
Set fso = CreateObject("scripting.filesystemobject")

If fso.FileExists(MyFilePath) = True Then
    Application.ScreenUpdating = False
    Open MyFilePath For Input As #1
    Open tmpFile For Output As #2
    tmpString = Input(LOF(1), 1) 'read the entire file
    tmpString = Replace(tmpString, (Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
    & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
    & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
    & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
    & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
    & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
    & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34)), "") 'eliminate double quotation and commas in the first line with UTF-8
    Print #2, tmpString 'output result
    Close #1
    Close #2
    fso.DeleteFile (MyFilePath) 'delete original file
    fso.CopyFile tmpFile, MyFilePath, True 'rename temp file
    fso.DeleteFile (tmpFile) 'delete temp file
    Application.ScreenUpdating = True
    MsgBox "Finished processing file", vbInformation, "Done!"
Else
    MsgBox "Cannot locate the file : " & MyFilePath, vbCritical, "Error"
End If
Set fso = Nothing
End Sub




' Get Parent Sub Directory Path
Function getDirSubParentPath()
getDirSubParentPath = ThisWorkbook.Path & Application.PathSeparator & "CSV" & Application.PathSeparator & "Parent" & Application.PathSeparator
End Function


推荐答案

管理创建似乎可行的解决方案。然而，代码可以使用一些清理:)但它得到了工作完成。

所以基本上，我有一些问题的循环。它将返回一个名为W16-0的文件（实际只是W16）。它应该只添加-X如果找到W16。所以增量订单应该是W16，W16-1，W16-2等。

我所做的是，我试图找到如果有一个W16-0，然后替换为W16。此外，它似乎循环将给我一个比我有的文件数量。这就是我也有一个错误。所以如果我有一个W16-4，它会要求宏找到并打开一个名为W16-5的文件，这显然不存在。

如果有人可以帮助我清理代码，我会非常感谢！

I finally manage to create a solution that seems viable. However, the code could use some cleaning up :) But it gets the job done.
So basically, I am having some issues with the loop. It will return a file named W16-0 (which should actual just be W16). It should only add the "-X" if W16 is found. So the incremental order should be W16, W16-1, W16-2, etc.
What I am doing is that I try to locate if there is a W16-0 and then replace it with W16. Furthermore, it seems like the loop will give me one higher than the amount of files I have. So that is where I also got an error. So if I had a W16-4, it would ask the macro to find and open a file named W16-5, which would obviously not exist.
If somebody could help me clean up the code, I would be really thankful!

Sub RemoveCommasDoubleQ()
'
'    Enable a reference to 'Microsft Scripting Runtime'
'    under VBA menu option Tools > References

Dim week, UserName As String
Dim MyFile, MyFilePath As String
Dim version As Integer

Dim fso As Object 'scripting.filesystemobject
Set fso = CreateObject("scripting.filesystemobject")

' Current week, XX
week = Format(Date, "ww")
' Username, e.g. niclas.madsen
UserName = Environ$("UserName")
' Initials, first letter of last and surname to caps
' e.g. niclas.madsen would be NM
UserName = UCase(Left(UserName, 1) & Mid(UserName, InStr(UserName, ".") + 1, 1))

' fix filename for saving purpose
MyFile = Replace(Replace("SupplierOrganization_W", "", ""), ".", "_") _
            & "" _
            & week _
            & " " _
            & UserName _
            & ".csv"
    'SupplierOrganization_WXX NM

'MyFilePath = ThisWorkbook.Path & "\CSV\Parent\" & MyFile
MyFilePath = getDirSubParentPath & MyFile

Debug.Print MyFilePath
Debug.Print "BEFORE LOOP"
'version = 1

Do While Len(Dir(MyFilePath)) <> 0
     '// If it does, then append a _000 to the name
     '// Change _000 to suit your requirement
    MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"

     '// Increment the counter
    version = version + 1

     '// and go around again

    If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv" Then
       MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
       Debug.Print MyFilePath
       Debug.Print "IF LOOP"
    End If
Loop
Debug.Print MyFilePath
Debug.Print "LOOP"

If fso.FileExists(getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv") = False Then
    MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version - 2 & " " & UserName & ".csv"
    MsgBox getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
End If

fileName = fso.GetFileName(MyFilePath)
Debug.Print fileName

If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv" Then
   MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
   Debug.Print MyFilePath
   Debug.Print "her it should be 0"
End If

If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & " " & UserName & ".csv" Then
   MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
End If



Debug.Print "HER ER VI"
fileName = fso.GetFileName(MyFilePath)
Debug.Print fileName


Dim tmpFile, tmpFilePath As String
tmpFile = getDirSubParentPath & "tmp_file.txt"

Dim tmpString As String

Debug.Print "------"
Debug.Print MyFilePath

If fso.FileExists(getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv") = True Then
   MsgBox "Found the W-0"
   MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
End If

Debug.Print "Found 0?"
Debug.Print MyFilePath


If fso.FileExists(MyFilePath) = True Then
    Application.ScreenUpdating = False
    Open MyFilePath For Input As #1
    Open tmpFile For Output As #2
    tmpString = Input(LOF(1), 1) 'read the entire file
    tmpString = Replace(tmpString, (Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
    & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
    & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
    & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
    & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
    & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
    & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
    & Chr(34)), "") 'eliminate double quotation and commas in the first line with UTF-8
    Print #2, tmpString 'output result
    Close #1
    Close #2
    fso.DeleteFile (MyFilePath) 'delete original file
    fso.CopyFile tmpFile, MyFilePath, True 'rename temp file
    fso.DeleteFile (tmpFile) 'delete temp file
    Application.ScreenUpdating = True
    MsgBox "Finished processing file", vbInformation, "Done!"
Else
    MsgBox "Cannot locate the file : " & MyFile, vbCritical, "Error"
End If
Set fso = Nothing
End Sub

这篇关于如何在Excel / VBA中将增量计数（版本）添加到字符串（文件）中？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

10-27 01:42
Powered by LMLPHP ©2024 W16 0.004379